← Back to branch summary

~ubuntu-branches/ubuntu/oneiric/gnome-games/oneiric

« back to all changes in this revision

Viewing changes to aisleriot/rules/treize.scm

  • Committer: Package Import Robot
  • Author(s): Jeremy Bicha
  • Date: 2011-07-21 04:22:50 UTC
  • mfrom: (1.1.93)
  • Revision ID: package-import@ubuntu.com-20110721042250-far722bxogjk1rhi
Tags: 1:3.1.3-0ubuntu1
https://launchpad.net/bugs/788514
* New upstream release
  - Aisleriot was split out of gnome-games into its own module.
  - Gnotravex was ported to GSettings.
  - Sudoku was ported to PyGObject/GTK3 by John Stowers.
* debian/aisleriot*: Dropped
* debian/control
  - Drop aisleriot package
  - Recommend aisleriot
  - Disable lightsoff & swell-foop as they're not ready yet
  - Re-enable gnome-sudoku
  - Use python-gobject instead of python-gtk2
  - Don't use python-launchpad-integration as it doesn't work with pygi yet
  - Switch to dh_python2 (LP: #788514)
  - Drop old pre-Lucid conflicts with gnome-cards-data & gnome-games-data
  - Drop obsolete build-depends: check, dpkg-dev, guile-1.8, lsb-release,
    rarian-compat, & scrollkeeper
  - Use ${gir:Depends}
* debian/copyright: Drop aisleriot & blackjack entries
* debian/glchess.install: Drop gnome-gnuchess
* debian/gnome-games-common.install: Drop aisleriot entries
* debian/gnome-sudoku.install: Install gconf schema
* debian/gnotravex.install: Install GSettings schema
* debian/rules
  - Clean up configure flags
  - Switch to dh_python2
* debian/watch: Watch for .bz2
* debian/patches/01_lpi.patch: Refreshed
* debian/patches/02_desktop-path.patch: Removed aisleriot references
* debian/patches/03_add-appinstall-keywords.patch
  - Add keywords to make searching for the games easier in Software Center

Show diffs side-by-side

added added

removed removed

Lines of Context:
aisleriot/rules/treize.scm
1
 
; AisleRiot - treize.scm
2
 
; Copyright (C) 2001, 2003 Rosanna Yuen <zana@webwynk.net>
3
 
;
4
 
; This program is free software: you can redistribute it and/or modify
5
 
; it under the terms of the GNU General Public License as published by
6
 
; the Free Software Foundation, either version 3 of the License, or
7
 
; (at your option) any later version.
8
 
;
9
 
; This program is distributed in the hope that it will be useful,
10
 
; but WITHOUT ANY WARRANTY; without even the implied warranty of
11
 
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12
 
; GNU General Public License for more details.
13
 
;
14
 
; You should have received a copy of the GNU General Public License
15
 
; along with this program.  If not, see <http://www.gnu.org/licenses/>.
16
 
 
17
 
(define (new-game)
18
 
  (initialize-playing-area)  
19
 
  (set-ace-low)
20
 
  (make-standard-deck)
21
 
  (shuffle-deck)
22
 
 
23
 
  (add-normal-slot DECK)
24
 
  (add-normal-slot '())
25
 
  (set! HORIZPOS (- HORIZPOS (/ 2 3)))
26
 
  (add-extended-slot '() right)
27
 
 
28
 
  (add-carriage-return-slot)
29
 
 
30
 
  (add-blank-slot)
31
 
  (add-blank-slot)
32
 
  (add-blank-slot)
33
 
  (add-normal-slot '())
34
 
 
35
 
  (add-carriage-return-slot)
36
 
  (set! VERTPOS (- VERTPOS (/ 2 3)))
37
 
  (set! HORIZPOS (+ HORIZPOS 0.5))
38
 
  (add-blank-slot)
39
 
  (add-blank-slot)
40
 
  (add-normal-slot '())
41
 
  (add-normal-slot '())
42
 
 
43
 
  (add-carriage-return-slot)
44
 
  (set! VERTPOS (- VERTPOS (/ 2 3)))
45
 
  (add-blank-slot)
46
 
  (add-blank-slot)
47
 
  (add-normal-slot '())
48
 
  (add-normal-slot '())
49
 
  (add-normal-slot '())
50
 
 
51
 
  (add-carriage-return-slot)
52
 
  (set! VERTPOS (- VERTPOS (/ 2 3)))
53
 
  (set! HORIZPOS (+ HORIZPOS 0.5))
54
 
  (add-blank-slot)
55
 
  (add-normal-slot '())
56
 
  (add-normal-slot '())
57
 
  (add-normal-slot '())
58
 
  (add-normal-slot '())
59
 
 
60
 
  (add-carriage-return-slot)
61
 
  (set! VERTPOS (- VERTPOS (/ 2 3)))
62
 
  (add-blank-slot)
63
 
  (add-normal-slot '())
64
 
  (add-normal-slot '())
65
 
  (add-normal-slot '())
66
 
  (add-normal-slot '())
67
 
  (add-normal-slot '())
68
 
 
69
 
  (add-carriage-return-slot)
70
 
  (set! VERTPOS (- VERTPOS (/ 2 3)))
71
 
  (set! HORIZPOS (+ HORIZPOS 0.5))
72
 
  (add-normal-slot '())
73
 
  (add-normal-slot '())
74
 
  (add-normal-slot '())
75
 
  (add-normal-slot '())
76
 
  (add-normal-slot '())
77
 
  (add-normal-slot '())
78
 
 
79
 
  (add-carriage-return-slot)
80
 
  (set! VERTPOS (- VERTPOS (/ 2 3)))
81
 
  (add-normal-slot '())
82
 
  (add-normal-slot '())
83
 
  (add-normal-slot '())
84
 
  (add-normal-slot '())
85
 
  (add-normal-slot '())
86
 
  (add-normal-slot '())
87
 
  (add-normal-slot '())
88
 
 
89
 
  (deal-cards-face-up 0 ' (3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19
90
 
                             20 21 22 23 24 25 26 27 28 29 30))
91
 
 
92
 
  (give-status-message)
93
 
 
94
 
  (list 7 4))
95
 
 
96
 
(define (give-status-message)
97
 
  (set-statusbar-message (get-stock-no-string)))
98
 
 
99
 
(define (get-stock-no-string)
100
 
  (string-append (_"Stock left:") " " 
101
 
                 (number->string (length (get-cards 0)))))
102
 
 
103
 
(define (button-pressed slot-id card-list)
104
 
  (and (not (empty-slot? slot-id))
105
 
       (not (= (get-value (car card-list)) king))
106
 
       (available? slot-id 0)
107
 
       (= (length card-list) 1)))
108
 
 
109
 
(define (available? slot-id r-slot)
110
 
  (cond ((or (= slot-id 1)
111
 
             (= slot-id 2))
112
 
         #t)
113
 
        ((= slot-id 0)
114
 
         #f)
115
 
        ((= slot-id 23)
116
 
         (and (empty-slot? 29)
117
 
              (empty-slot? 30)
118
 
              (not (= r-slot 29))
119
 
              (not (= r-slot 30))))
120
 
        ((= slot-id 22)
121
 
         (and (empty-slot? 28)
122
 
              (empty-slot? 29)
123
 
              (not (= r-slot 28))
124
 
              (not (= r-slot 29))))
125
 
        ((= slot-id 21)
126
 
         (and (empty-slot? 27)
127
 
              (empty-slot? 28)
128
 
              (not (= r-slot 27))
129
 
              (not (= r-slot 28))))
130
 
        ((= slot-id 20)
131
 
         (and (empty-slot? 26)
132
 
              (empty-slot? 27)
133
 
              (not (= r-slot 26))
134
 
              (not (= r-slot 27))))
135
 
        ((= slot-id 19)
136
 
         (and (empty-slot? 25)
137
 
              (empty-slot? 26)
138
 
              (not (= r-slot 25))
139
 
              (not (= r-slot 26))))
140
 
        ((= slot-id 18)
141
 
         (and (empty-slot? 24)
142
 
              (empty-slot? 25)
143
 
              (not (= r-slot 24))
144
 
              (not (= r-slot 25))))
145
 
        ((= slot-id 17)
146
 
         (and (empty-slot? 22)
147
 
              (empty-slot? 23)
148
 
              (not (= r-slot 22))
149
 
              (not (= r-slot 23))))
150
 
        ((= slot-id 16)
151
 
         (and (empty-slot? 21)
152
 
              (empty-slot? 22)
153
 
              (not (= r-slot 21))
154
 
              (not (= r-slot 22))))
155
 
        ((= slot-id 15)
156
 
         (and (empty-slot? 20)
157
 
              (empty-slot? 21)
158
 
              (not (= r-slot 20))
159
 
              (not (= r-slot 21))))
160
 
        ((= slot-id 14)
161
 
         (and (empty-slot? 19)
162
 
              (empty-slot? 20)
163
 
              (not (= r-slot 19))
164
 
              (not (= r-slot 20))))
165
 
        ((= slot-id 13)
166
 
         (and (empty-slot? 18)
167
 
              (empty-slot? 19)
168
 
              (not (= r-slot 18))
169
 
              (not (= r-slot 19))))
170
 
        ((= slot-id 12)
171
 
         (and (empty-slot? 16)
172
 
              (empty-slot? 17)
173
 
              (not (= r-slot 16))
174
 
              (not (= r-slot 17))))
175
 
        ((= slot-id 11)
176
 
         (and (empty-slot? 15)
177
 
              (empty-slot? 16)
178
 
              (not (= r-slot 15))
179
 
              (not (= r-slot 16))))
180
 
        ((= slot-id 10)
181
 
         (and (empty-slot? 14)
182
 
              (empty-slot? 15)
183
 
              (not (= r-slot 14))
184
 
              (not (= r-slot 15))))
185
 
        ((= slot-id 9)
186
 
         (and (empty-slot? 13)
187
 
              (empty-slot? 14)
188
 
              (not (= r-slot 13))
189
 
              (not (= r-slot 14))))
190
 
        ((= slot-id 8)
191
 
         (and (empty-slot? 11)
192
 
              (empty-slot? 12)
193
 
              (not (= r-slot 11))
194
 
              (not (= r-slot 12))))
195
 
        ((= slot-id 7)
196
 
         (and (empty-slot? 10)
197
 
              (empty-slot? 11)
198
 
              (not (= r-slot 10))
199
 
              (not (= r-slot 11))))
200
 
        ((= slot-id 6)
201
 
         (and (empty-slot? 9)
202
 
              (empty-slot? 10)
203
 
              (not (= r-slot 9))
204
 
              (not (= r-slot 10))))
205
 
        ((= slot-id 5)
206
 
         (and (empty-slot? 7)
207
 
              (empty-slot? 8)
208
 
              (not (= r-slot 7))
209
 
              (not (= r-slot 8))))
210
 
        ((= slot-id 4)
211
 
         (and (empty-slot? 6)
212
 
              (empty-slot? 7)
213
 
              (not (= r-slot 6))
214
 
              (not (= r-slot 7))))
215
 
        ((= slot-id 3)
216
 
         (and (empty-slot? 4)
217
 
              (empty-slot? 5)
218
 
              (not (= r-slot 4))
219
 
              (not (= r-slot 5))))))
220
 
 
221
 
(define (droppable? start-slot card-list end-slot)
222
 
  (and (not (empty-slot? end-slot))
223
 
       (available? end-slot start-slot)
224
 
       (= 13 (+ (get-value (car card-list))
225
 
                (get-value (get-top-card end-slot))))))
226
 
 
227
 
(define (button-released start-slot card-list end-slot)
228
 
  (and (droppable? start-slot card-list end-slot)
229
 
       (add-to-score! 2)
230
 
       (remove-card end-slot)
231
 
       (if (or (= start-slot 1)
232
 
               (= end-slot 1))
233
 
           (if (not (empty-slot? 2))
234
 
               (begin
235
 
                 (let ((new-contents (get-cards 2)))
236
 
                   (let ((moving-back (car (reverse new-contents))))
237
 
                     (set-cards! 1 (list moving-back)))
238
 
                   (set-cards! 2 (reverse (cdr (reverse new-contents))))))
239
 
               #t)
240
 
           #t)))
241
 
 
242
 
(define (button-clicked slot-id)
243
 
  (if (= slot-id 0)
244
 
      (if (empty-slot? 1)
245
 
          (and (not (empty-slot? 0))
246
 
               (deal-cards-face-up 0 '(1)))
247
 
          (and (not (empty-slot? 0))
248
 
               (deal-cards-face-up 0 '(2))))
249
 
      (and (not (empty-slot? slot-id))
250
 
           (available? slot-id 0)
251
 
           (= (get-value (get-top-card slot-id))
252
 
              king)
253
 
           (remove-card slot-id)
254
 
           (if (= slot-id 1)
255
 
               (if (not (empty-slot? 2))
256
 
                   (begin
257
 
                     (let ((new-contents (get-cards 2)))
258
 
                       (let ((moving-back (car (reverse new-contents))))
259
 
                         (set-cards! 1 (list moving-back)))
260
 
                       (set-cards! 2 (reverse (cdr (reverse new-contents))))))))
261
 
           (add-to-score! 1))))
262
 
 
263
 
(define (button-double-clicked slot-id)
264
 
  #f)
265
 
 
266
 
(define (game-continuable)
267
 
  (give-status-message)
268
 
  (and (not (game-won))
269
 
       (get-hint)))
270
 
 
271
 
(define (game-won)
272
 
  (and (empty-slot? 3)
273
 
       (empty-slot? 1)
274
 
       (empty-slot? 0)))
275
 
 
276
 
(define (check-move slot1 slot2)
277
 
  (if (or (empty-slot? slot1)
278
 
          (not (available? slot1 0)))
279
 
      (if (< slot1 29)
280
 
          (check-move (+ 1 slot1) (+ 2 slot1))
281
 
          #f)
282
 
      (if (= king (get-value (get-top-card slot1)))
283
 
          (list 2 (get-name (get-top-card slot1)) (_"itself"))
284
 
          (if (or (empty-slot? slot2)
285
 
                  (not (available? slot2 0))
286
 
                  (not (= 13 (+ (get-value (get-top-card slot1))
287
 
                                (get-value (get-top-card slot2))))))
288
 
              (if (< slot2 30)
289
 
                  (check-move slot1 (+ 1 slot2))
290
 
                  (if (< slot1 29)
291
 
                      (check-move (+ 1 slot1) (+ 2 slot1))
292
 
                      #f))
293
 
              (list 1 
294
 
                    (get-name (get-top-card slot1)) 
295
 
                    (get-name (get-top-card slot2)))))))
296
 
 
297
 
(define (dealable?)
298
 
  (if (not (empty-slot? 0))
299
 
      (list 0 (_"Deal a card"))
300
 
      #f))
301
 
 
302
 
(define (check-waste)
303
 
  (and (not (empty-slot? 2))
304
 
       (> (length (get-cards 2)) 1)
305
 
       (= 13 (+ (get-value (get-top-card 2))
306
 
                (get-value (cadr (get-cards 2)))))
307
 
       (list 1
308
 
             (get-name (get-top-card 2))
309
 
             (get-name (cadr (get-cards 2))))))
310
 
 
311
 
(define (get-hint)
312
 
  (or (check-move 1 2)  
313
 
      (check-waste)
314
 
      (dealable?)))
315
 
 
316
 
(define (get-options) 
317
 
  #f)
318
 
 
319
 
(define (apply-options options) 
320
 
  #f)
321
 
 
322
 
(define (timeout) 
323
 
  #f)
324
 
 
325
 
(set-features droppable-feature)
326
 
 
327
 
(set-lambda new-game button-pressed button-released button-clicked
328
 
button-double-clicked game-continuable game-won get-hint get-options
329
 
apply-options timeout droppable?)