← Back to branch summary

~ubuntu-branches/debian/sid/aisleriot/sid

« back to all changes in this revision

Viewing changes to games/forty-thieves.scm

  • Committer: Package Import Robot
  • Author(s): Andreas Henriksson, Jeremy Bicha, Jackson Doak, Andreas Henriksson
  • Date: 2013-10-17 23:33:36 UTC
  • mfrom: (1.1.3)
  • Revision ID: package-import@ubuntu.com-20131017233336-s2rn2lklucl6az43
Tags: 1:3.10.1-1
[ Jeremy Bicha ]
* New upstream release. 1:3.9.90-1
* debian/control.in:
  - Lower GTK dependency back to 3.4
  - Update homepage

[ Jackson Doak ]
* New upstream release (v3.10.0)

[ Andreas Henriksson ]
* New upstream release (v3.10.1)
* Bump Standards-Version to 3.9.4

Show diffs side-by-side

added added

removed removed

Lines of Context:
games/forty-thieves.scm
16
16
 
17
17
(use-modules (aisleriot interface) (aisleriot api))
18
18
 
 
19
(define stock 0)
 
20
(define foundation '(1 2 3 4 5 6 7 8))
 
21
(define waste 9)
 
22
(define tableau '(10 11 12 13 14 15 16 17 18 19))
 
23
 
19
24
(define (new-game)
20
25
  (initialize-playing-area)
21
26
  (set-ace-low)
53
58
  (add-extended-slot '() down 'tableau)
54
59
 
55
60
; these are the forty theives in the tableau
56
 
  (deal-cards-face-up 0 '(10 11 12 13 14 15 16 17 18 19))
57
 
  (deal-cards-face-up 0 '(10 11 12 13 14 15 16 17 18 19))
58
 
  (deal-cards-face-up 0 '(10 11 12 13 14 15 16 17 18 19))
59
 
  (deal-cards-face-up 0 '(10 11 12 13 14 15 16 17 18 19))
 
61
  (deal-cards-face-up 0 tableau)
 
62
  (deal-cards-face-up 0 tableau)
 
63
  (deal-cards-face-up 0 tableau)
 
64
  (deal-cards-face-up 0 tableau)
60
65
 
61
66
  (give-status-message)
62
67
; this is the return list of (new-game) and sets the size of the 
220
225
; no cards are actually moved this is a helper for both double-click
221
226
; and get-hint features.
222
227
 
 
228
(define (try-all-foundations-helper from-slot card to-slots)
 
229
  (if (null? to-slots)
 
230
      (list #f)
 
231
      (if (foundation-droppable? (list card) (car to-slots))
 
232
          (list #t from-slot (car to-slots))
 
233
          (try-all-foundations-helper from-slot card (cdr to-slots)))))
 
234
 
223
235
(define (try-all-foundations from-slot card )
224
 
    (if (not (empty-slot? from-slot))
225
 
      (if (foundation-droppable? (list card) 1) 
226
 
        (list #t from-slot 1)
227
 
        (if (foundation-droppable? (list card) 2) 
228
 
          (list #t from-slot 2)
229
 
          (if (foundation-droppable? (list card) 3) 
230
 
            (list #t from-slot 3)
231
 
            (if (foundation-droppable? (list card) 4) 
232
 
              (list #t from-slot 4)
233
 
              (if (foundation-droppable? (list card) 5) 
234
 
                 (list #t from-slot 5)
235
 
                 (if (foundation-droppable? (list card) 6) 
236
 
                   (list #t from-slot 6)
237
 
                   (if (foundation-droppable? (list card) 7) 
238
 
                     (list #t from-slot 7)
239
 
                     (if (foundation-droppable? (list card) 8) 
240
 
                       (list #t from-slot 8)
241
 
                       (list #f)
242
 
       ) ) ) ) ) ) ) )
243
 
       (list #f)
244
 
     )
245
 
)
 
236
  (if (not (empty-slot? from-slot))
 
237
      (try-all-foundations-helper from-slot card foundation)
 
238
      (list #f)))
246
239
 
247
240
 
248
241
; return a move if a card can be moved from from-slot to a tableau
249
242
; slot. This is a helper for hint, and double-click
 
243
 
 
244
(define (find-tableau-place-helper from-slot card to-slots)
 
245
  (if (null? to-slots)
 
246
      #f
 
247
      (if (and
 
248
            (not (empty-slot? (car to-slots)))
 
249
            (tableau-droppable? from-slot (list card) (car to-slots))
 
250
            (<> from-slot (car to-slots)))
 
251
          (list #t from-slot (car to-slots))
 
252
          (find-tableau-place-helper from-slot card (cdr to-slots)))))
 
253
 
250
254
(define (find-tableau-place from-slot card )
251
 
    (if (not (empty-slot? from-slot))
252
 
      (if (and (tableau-droppable? from-slot (list card) 10) (<> from-slot 10) )
253
 
        (list #t from-slot 10)
254
 
        (if (and (tableau-droppable? from-slot (list card) 11) (<> from-slot 11) )
255
 
          (list #t from-slot 11)
256
 
          (if (and (tableau-droppable? from-slot (list card) 12) (<> from-slot 12) )
257
 
            (list #t from-slot 12)
258
 
            (if (and (tableau-droppable? from-slot (list card) 13) (<> from-slot 13) )
259
 
              (list #t from-slot 13)
260
 
              (if (and (tableau-droppable? from-slot (list card) 14) (<> from-slot 14) )
261
 
                (list #t from-slot 14)
262
 
                (if (and (tableau-droppable? from-slot (list card) 15) (<> from-slot 15) )
263
 
                  (list #t from-slot 15)
264
 
                  (if (and (tableau-droppable? from-slot (list card) 16) (<> from-slot 16) )
265
 
                    (list #t from-slot 16)
266
 
                    (if (and (tableau-droppable? from-slot (list card) 17) (<> from-slot 17) )
267
 
                      (list #t from-slot 17)
268
 
                      (if (and (tableau-droppable? from-slot (list card) 18) (<> from-slot 18) )
269
 
                        (list #t from-slot 18)
270
 
                        (if (and (tableau-droppable? from-slot (list card) 19) (<> from-slot 19) )
271
 
                          (list #t from-slot 19)
272
 
                          (list #f)
273
 
      ) ) ) ) ) ) ) ) ) ) 
274
 
      (list #f)
275
 
    )
276
 
)
277
 
 
 
255
  (if (not (empty-slot? from-slot))
 
256
      (or
 
257
        (find-tableau-place-helper from-slot card tableau)
 
258
        (and (find-empty-slot tableau) (list #t from-slot (find-empty-slot tableau)))
 
259
        (list #f))
 
260
      (list #f)))
278
261
 
279
262
 
280
263
(define (dealable?)