[Aisleriot] Freecell game selection, Redmond style

["Bastien-F Jonathan" <J Bastien-F cgodin qc ca>]

Being intrigued by how MS Freecell generated its games, I have looked into this topic and managed to modify Aisleriot to generate the same set of games. No reverse engineering was required as the specifications are publicly available (use the google my friend).

The "backend" code is done, I am now looking to add general seed selection (MS style or not) to Aisleriot. Many people I know write down a bunch of random numbers on a piece of paper and work through the games sequentially. It would be nice to have the game number in the title bar. I am somewhat puzzled on how to ask the user for the game number as my gtk-fu is a bit rusty. Of course, I would like this to be done in the friendliest manner, conforming to the gnome standards. If someone could help me write the frontend code, or, minimally, give me a general specification for the interface to enable me to code it myself.

Anyway, here is a rough first patch for the backend code, it is the first useful thing I have coded in Lisp/scheme, so it might be ugly. It is diffed against gnome-games 2.16.3 (debian) so you might need to adapt it for bleeding edge.

--- freecell.scm.distrib        2007-01-28 11:52:53.000000000 -0500
+++ freecell.scm        2007-02-16 16:02:35.000000000 -0500
@@ -81,6 +81,44 @@
 ;; Utilities
 ;;

+(define redmond-seed 0)
+
+(define (redmond-srand s)
+  (set! redmond-seed s))
+
+(define (redmond-rand)
+  (set! redmond-seed
+               (+ (* redmond-seed 214013) 2531011))
+  (modulo (ash redmond-seed -16)
+                 (expt 2 15)))
+
+(define (make-redmond-deck)
+  (set! DECK (make-deck-list-redmond 0)))
+
+(define (make-deck-list-redmond value)
+  (if (eq? value 51)
+         (list (make-card (+ (quotient value 4) 1) (modulo value 4)))
+         (cons (make-card (+ (quotient value 4) 1) (modulo value 4))
+                       (make-deck-list-redmond (+ 1 value)))))
+
+(define (redmond-adjust-list deck n)
+  (if (eq? n (- (length deck) 1))
+         (list-head deck (- (length deck) 1))
+         (append (list-head deck n)
+                         (last-pair deck)
+                         (cdr (list-tail (list-head deck (- (length deck) 1)) n )))))
+
+(define (shuffle-deck-list-redmond deck)
+  (let ((n (modulo (redmond-rand) (length deck))))
+       (if (eq? 1 (length deck))
+               deck
+               (cons (list-ref deck n )
+                         (shuffle-deck-list-redmond (redmond-adjust-list deck n ))))))
+
+(define (shuffle-deck-redmond gamenum)
+  (redmond-srand gamenum)
+  (set! DECK (shuffle-deck-list-redmond DECK)))
+
 (define (freecell? slot)
   (and (>= slot freecell-1) (<= slot freecell-4)))

@@ -318,8 +356,10 @@
 (define (new-game)
   (initialize-playing-area)
   (set-ace-low)
-  (make-standard-deck)
-  (shuffle-deck)
+;;  (make-standard-deck)
+  (make-redmond-deck)
+;;  (shuffle-deck)
+  (shuffle-deck-redmond 32000)

   ;; set up the board

joe freedom4:~/prog/redmond_freecell$ diff -u freecell.scm.distrib freecell.scm
--- freecell.scm.distrib        2007-01-28 11:52:53.000000000 -0500
+++ freecell.scm        2007-02-16 18:30:00.000000000 -0500
@@ -81,6 +81,45 @@
 ;; Utilities
 ;;

+(define redmond-seed 0)
+
+(define (redmond-srand s)
+  (set! redmond-seed s))
+
+(define (redmond-rand)
+  (set! redmond-seed
+               (+ (* redmond-seed 214013) 2531011))
+  (modulo (ash redmond-seed -16)
+                 (expt 2 15)))
+
+(define (make-redmond-deck)
+  (set! DECK (make-deck-list-redmond 0)))
+
+(define (make-deck-list-redmond value)
+  (if (eq? value 51)
+         (list (make-card (+ (quotient value 4) 1) (modulo value 4)))
+         (cons (make-card (+ (quotient value 4) 1) (modulo value 4))
+                       (make-deck-list-redmond (+ 1 value)))))
+
+(define (redmond-adjust-list deck n)
+  (if (eq? n (- (length deck) 1))
+         (list-head deck (- (length deck) 1))
+         (append (list-head deck n)
+                         (last-pair deck)
+                         (cdr (list-tail (list-head deck (- (length deck) 1)) n)))))
+
+(define (shuffle-deck-list-redmond deck)
+  (let ((n (modulo (redmond-rand) (length deck))))
+       (if (eq? 1 (length deck))
+               deck
+               (cons (list-ref deck n )
+                         (shuffle-deck-list-redmond
+                          (redmond-adjust-list deck n))))))
+
+(define (shuffle-deck-redmond gamenum)
+  (redmond-srand gamenum)
+  (set! DECK (shuffle-deck-list-redmond DECK)))
+
 (define (freecell? slot)
   (and (>= slot freecell-1) (<= slot freecell-4)))

@@ -318,8 +357,10 @@
 (define (new-game)
   (initialize-playing-area)
   (set-ace-low)
-  (make-standard-deck)
-  (shuffle-deck)
+;;  (make-standard-deck)
+  (make-redmond-deck)
+;;  (shuffle-deck)
+  (shuffle-deck-redmond 32000)

   ;; set up the board

Cheers, looking forward to work with you guys on this,
Jonathan