← Back to branch summary

~ubuntu-branches/debian/jessie/aisleriot/jessie

« back to all changes in this revision

Viewing changes to games/camelot.scm

  • Committer: Package Import Robot
  • Author(s): Jordi Mallach, Jeremy Bicha, Jordi Mallach
  • Date: 2012-04-22 12:49:26 UTC
  • mfrom: (1.1.1)
  • Revision ID: package-import@ubuntu.com-20120422124926-gmr0thwstl91jt1n
Tags: 1:3.4.1-1
[ Jeremy Bicha ]
* New upstream release
* debian/control.in: (Build)-depend on guile-2.0
* debian/*.install: Cards files are now stored as zipped .svg's
* debian/patches/99_format-security.patch: Dropped, applied upstream

[ Jordi Mallach ]
* New upstream release.
* Update copyright to final version of the machine-readable 1.0 spec.
* Bump Standards Version to 3.9.3.

Show diffs side-by-side

added added

removed removed

Lines of Context:
games/camelot.scm
14
14
; You should have received a copy of the GNU General Public License
15
15
; along with this program.  If not, see <http://www.gnu.org/licenses/>.
16
16
 
 
17
(use-modules (aisleriot interface) (aisleriot api))
 
18
 
17
19
(def-save-var add-stage #t)
18
20
(def-save-var fill-count 0)
19
21
 
26
28
  (add-blank-slot)
27
29
  (add-blank-slot)
28
30
  (set! HORIZPOS (+ HORIZPOS 0.5))
29
 
  (add-normal-slot '())           ; Slot 0
30
 
  (add-normal-slot '())           ; Slot 1
31
 
  (add-normal-slot '())           ; Slot 2
32
 
  (add-normal-slot '())           ; Slot 3
33
 
  (add-carriage-return-slot)
34
 
  (add-blank-slot)
35
 
  (add-blank-slot)
36
 
  (set! HORIZPOS (+ HORIZPOS 0.5))
37
 
  (add-normal-slot '())           ; Slot 4
38
 
  (add-normal-slot '())           ; Slot 5
39
 
  (add-normal-slot '())           ; Slot 6
40
 
  (add-normal-slot '())           ; Slot 7
41
 
  (add-carriage-return-slot)
42
 
  (add-blank-slot)
43
 
  (add-blank-slot)
44
 
  (set! HORIZPOS (+ HORIZPOS 0.5))
45
 
  (add-normal-slot '())           ; Slot 8
46
 
  (add-normal-slot '())           ; Slot 9
47
 
  (add-normal-slot '())           ; Slot 10
48
 
  (add-normal-slot '())           ; Slot 11
49
 
  (add-carriage-return-slot)
50
 
  (add-blank-slot)
51
 
  (add-blank-slot)
52
 
  (set! HORIZPOS (+ HORIZPOS 0.5))
53
 
  (add-normal-slot '())           ; Slot 12
54
 
  (add-normal-slot '())           ; Slot 13
55
 
  (add-normal-slot '())           ; Slot 14
56
 
  (add-normal-slot '())           ; Slot 15
 
31
  (add-normal-slot '() 'corner)           ; Slot 0
 
32
  (add-normal-slot '() 'top)              ; Slot 1
 
33
  (add-normal-slot '() 'top)              ; Slot 2
 
34
  (add-normal-slot '() 'corner)           ; Slot 3
 
35
  (add-carriage-return-slot)
 
36
  (add-blank-slot)
 
37
  (add-blank-slot)
 
38
  (set! HORIZPOS (+ HORIZPOS 0.5))
 
39
  (add-normal-slot '() 'left)     ; Slot 4
 
40
  (add-normal-slot '() 'tableau)  ; Slot 5
 
41
  (add-normal-slot '() 'tableau)  ; Slot 6
 
42
  (add-normal-slot '() 'right)    ; Slot 7
 
43
  (add-carriage-return-slot)
 
44
  (add-blank-slot)
 
45
  (add-blank-slot)
 
46
  (set! HORIZPOS (+ HORIZPOS 0.5))
 
47
  (add-normal-slot '() 'left)     ; Slot 8
 
48
  (add-normal-slot '() 'tableau)  ; Slot 9
 
49
  (add-normal-slot '() 'tableau)  ; Slot 10
 
50
  (add-normal-slot '() 'right)    ; Slot 11
 
51
  (add-carriage-return-slot)
 
52
  (add-blank-slot)
 
53
  (add-blank-slot)
 
54
  (set! HORIZPOS (+ HORIZPOS 0.5))
 
55
  (add-normal-slot '() 'corner)   ; Slot 12
 
56
  (add-normal-slot '() 'bottom)   ; Slot 13
 
57
  (add-normal-slot '() 'bottom)   ; Slot 14
 
58
  (add-normal-slot '() 'corner)   ; Slot 15
57
59
 
58
60
  (set! HORIZPOS 0)
59
61
  (set! VERTPOS 0)
60
62
 
61
 
  (add-normal-slot DECK)          ; Slot 16
62
 
  (add-normal-slot '())           ; Slot 17
 
63
  (add-normal-slot DECK 'stock)   ; Slot 16
 
64
  (add-normal-slot '() 'waste)    ; Slot 17
63
65
  (set! add-stage #t)
64
66
  (set! fill-count 0)
65
67
 
162
164
       (empty-slot? 9)
163
165
       (empty-slot? 10)))
164
166
 
165
 
(define (list-cards slot)
166
 
  (if (= slot 16) 
167
 
      '() 
168
 
      (append (if (and (not (empty-slot? slot))
169
 
                       (< (get-value (get-top-card slot)) 11)) 
170
 
                  (get-cards slot) 
171
 
                  '()) 
172
 
              (list-cards (+ 1 slot)))))
173
 
 
174
 
(define (find-card-val-in-list? cards value)
175
 
  (and (not (null? cards))
176
 
       (if (= value (get-value (car cards))) 
177
 
           (car cards)
178
 
           (find-card-val-in-list? (cdr cards) value))))
179
 
 
180
 
(define (find-match cards)
181
 
  (and (not (null? cards))
182
 
       (if (= 10 (get-value (car cards))) 
183
 
           (list 2 (get-name (car cards)) (_"itself")) ; yuk..
184
 
           (let ((match (find-card-val-in-list? 
185
 
                         (cdr cards)
186
 
                         (- 10 (get-value (car cards))))))
187
 
             (if match
188
 
                 (list 1 (get-name (car cards)) (get-name match))
189
 
                 (find-match (cdr cards)))))))
 
167
(define (hint-remove-ten suit)
 
168
  (cond ((eq? suit club) (_"Remove the ten of clubs."))
 
169
        ((eq? suit diamond) (_"Remove the ten of diamonds."))
 
170
        ((eq? suit heart) (_"Remove the ten of hearts."))
 
171
        ((eq? suit spade) (_"Remove the ten of spades."))))
 
172
 
 
173
(define (find-match slot1 slot2)
 
174
  (cond ((= slot2 16) (find-match (+ 1 slot1) 0))
 
175
        ((= slot1 16) #f)
 
176
        ((or (empty-slot? slot2) (> (get-value (get-top-card slot2)) 10)) (find-match slot1 (+ 1 slot2)))
 
177
        ((or (empty-slot? slot1) (> (get-value (get-top-card slot1)) 10)) (find-match (+ 1 slot1) 0))
 
178
        ((= 10 (get-value (get-top-card slot2))) (list 0 (hint-remove-ten (get-suit (get-top-card slot2)))))
 
179
        ((= slot1 slot2) (find-match slot1 (+ 1 slot2)))
 
180
        ((= 10 (+ (get-value (get-top-card slot1)) (get-value (get-top-card slot2))))
 
181
         (hint-move slot1 1 slot2))
 
182
        (#t (find-match slot1 (+ 1 slot2)))))
190
183
 
191
184
(define (placeable? card)
192
185
  (cond ((= (get-value card) king)
193
 
         (and (or (empty-slot? 0)
194
 
                  (empty-slot? 3)
195
 
                  (empty-slot? 12)
196
 
                  (empty-slot? 15))
197
 
              (_"an empty corner slot")))
198
 
         ((= (get-value card) queen)
199
 
          (or (and (or (empty-slot? 1)
200
 
                       (empty-slot? 2))
201
 
                   (_"an empty top slot"))
202
 
              (and (or (empty-slot? 13)
203
 
                       (empty-slot? 14))
204
 
                   (_"an empty bottom slot"))))
 
186
         (find-empty-slot '(0 3 12 15)))
 
187
        ((= (get-value card) queen)
 
188
         (find-empty-slot '(1 2 13 14)))
205
189
        ((= (get-value card) jack)
206
 
          (or (and (or (empty-slot? 4)
207
 
                       (empty-slot? 8))
208
 
                   (_"an empty left slot"))
209
 
              (and (or (empty-slot? 7)
210
 
                       (empty-slot? 11))
211
 
                   (_"an empty right slot"))))
212
 
        (#t (_"an empty slot"))))
 
190
         (find-empty-slot '(4 8 7 11)))
 
191
        (#t
 
192
         (find-empty-slot '(5 6 9 10 0 1 2 3 4 7 8 11 12 13 14 15)))))
213
193
 
214
194
(define (game-over)
215
195
  (give-status-message)
217
197
          (and (empty-slot? 16) (empty-slot? 17)))
218
198
      (begin 
219
199
        (set! add-stage #f)
220
 
        (find-match (list-cards 0)))
 
200
        (find-match 0 0))
221
201
      (or (empty-slot? 17)
222
202
          (placeable? (get-top-card 17)))))
223
203
 
224
204
(define (get-hint)
225
205
  (or (if add-stage
226
206
          (and (not (empty-slot? 17))
227
 
               (list 2 (get-name (get-top-card 17))
228
 
                     (placeable? (get-top-card 17))))
229
 
          (find-match (list-cards 0)))
 
207
               (hint-move 17 1 (placeable? (get-top-card 17))))
 
208
          (find-match 0 0))
230
209
      (list 0 (_"Deal a new card from the deck"))))
231
210
 
232
211
(define (get-options) #f)