home *** CD-ROM | disk | FTP | other *** search
/ PC Welt 2006 November (DVD) / PCWELT_11_2006.ISO / casper / filesystem.squashfs / usr / share / sol-games / aunt_mary.scm < prev    next >
Encoding:
Text File  |  2006-08-22  |  1.5 KB  |  66 lines

  1. ;; AisleRiot - aunt_mary.scm  -*-scheme-*-
  2. ;; Copyright (C) Alan Horkan, 2005.
  3. ;; Aunt Mary is a very difficult Klondike variation.  
  4. ;; 
  5. ;; Goodsol gives odds as < 1%.  It is possible to win in theory.  
  6. ;; In practice I've only ever won when the deck wasn't shuffled
  7.  
  8. (load "klondike.scm") 
  9.  
  10. (define deal-three #f)
  11.  
  12. (define tableau '(6 7 8 9 10 11))
  13.  
  14. (define (new-game)
  15.   (initialize-playing-area)
  16.   (set-ace-low)
  17.  
  18.   (make-standard-deck)
  19.   (shuffle-deck)
  20.  
  21.   ;; Stock 
  22.   (add-normal-slot DECK)
  23.   (if deal-three
  24.       (add-partially-extended-slot '() right 3)
  25.       (add-normal-slot '()))
  26.  
  27.   ;; Foundation (4)
  28.   (add-normal-slot '())
  29.   (add-normal-slot '())
  30.   (add-normal-slot '())
  31.   (add-normal-slot '())
  32.   (add-carriage-return-slot)
  33.   ;; Tableau (6)
  34.   (add-extended-slot '() down)
  35.   (add-extended-slot '() down)
  36.   (add-extended-slot '() down)
  37.   (add-extended-slot '() down)
  38.   (add-extended-slot '() down)
  39.   (add-extended-slot '() down)
  40.  
  41.   ;; Pretty Good Solitaire (goodsol) deals Aunt Mary like this
  42.   (deal-cards stock 
  43.     '(  7 8 9 10 11 
  44.           8 9 10 11  
  45.             9 10 11 
  46.               10 11 
  47.                  11))
  48.   (deal-cards-face-up stock 
  49.     '(6 
  50.       6 7 
  51.       6 7 8 
  52.       6 7 8 9 
  53.       6 7 8 9 10 
  54.       6 7 8 9 10 11))
  55.  
  56.   (give-status-message)
  57.  
  58.   (list 7 3) 
  59. )
  60.  
  61. ;; One attempt.  No redeals
  62. (define (get-redeals-string)
  63.   (format (_"Redeals left: ~a") (number->string (- 0 FLIP-COUNTER))))
  64.  
  65. (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?)
  66.