← Back to branch summary

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

« back to all changes in this revision

Viewing changes to aisleriot/rules/zebra.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/zebra.scm
1
 
; AisleRiot - zebra.scm
2
 
; Copyright (C) 1999, 2003 Rosanna Yuen <rwsy@mit.edu>
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
 
  (set! DECK (append (make-deck-list-ace-low 2 2 club) 
21
 
                     (make-deck-list-ace-low 2 2 club)))
22
 
  (shuffle-deck)
23
 
 
24
 
  (add-normal-slot DECK)
25
 
  (add-normal-slot '())
26
 
 
27
 
  (set! HORIZPOS (+ HORIZPOS (/ 1 3)))
28
 
 
29
 
  (add-normal-slot (list (make-visible (make-card ace club))))
30
 
  (add-normal-slot (list (make-visible (make-card ace diamond))))
31
 
  (add-normal-slot (list (make-visible (make-card ace heart))))
32
 
  (add-normal-slot (list (make-visible (make-card ace spade))))
33
 
  (add-normal-slot (list (make-visible (make-card ace club))))
34
 
  (add-normal-slot (list (make-visible (make-card ace diamond))))
35
 
  (add-normal-slot (list (make-visible (make-card ace heart))))
36
 
  (add-normal-slot (list (make-visible (make-card ace spade))))
37
 
 
38
 
  (add-carriage-return-slot)
39
 
 
40
 
  (add-extended-slot '() down)
41
 
  (set! HORIZPOS (+ HORIZPOS (/ 7 21)))
42
 
  (add-extended-slot '() down)  7 21
43
 
  (set! HORIZPOS (+ HORIZPOS (/ 7 21)))
44
 
  (add-extended-slot '() down)  7 21
45
 
  (set! HORIZPOS (+ HORIZPOS (/ 7 21)))
46
 
  (add-extended-slot '() down)  7 21
47
 
  (set! HORIZPOS (+ HORIZPOS (/ 7 21)))
48
 
  (add-extended-slot '() down)  7 21
49
 
  (set! HORIZPOS (+ HORIZPOS (/ 7 21)))
50
 
  (add-extended-slot '() down)  7 21
51
 
  (set! HORIZPOS (+ HORIZPOS (/ 7 21)))
52
 
  (add-extended-slot '() down)  7 21
53
 
  (set! HORIZPOS (+ HORIZPOS (/ 7 21)))
54
 
  (add-extended-slot '() down)
55
 
 
56
 
  (deal-cards-face-up 0 '(10 11 12 13 14 15 16 17))
57
 
 
58
 
  (give-status-message)
59
 
 
60
 
  (list (+ 10 (/ 1 3)) 3)
61
 
)
62
 
 
63
 
(define (give-status-message)
64
 
  (set-statusbar-message (string-append (get-stock-no-string)
65
 
                                        "   "
66
 
                                        (get-redeals-string))))
67
 
 
68
 
(define (get-stock-no-string)
69
 
  (string-append (_"Stock left:") " " 
70
 
                 (number->string (length (get-cards 0)))))
71
 
 
72
 
(define (get-redeals-string)
73
 
  (string-append (_"Redeals left:") " "
74
 
                 (number->string (- 1 FLIP-COUNTER))))
75
 
 
76
 
(define (button-pressed slot-id card-list)
77
 
  (and (not (empty-slot? slot-id))
78
 
       (or (= slot-id 1)
79
 
           (> slot-id 9))))
80
 
 
81
 
(define (empty-tableau slot)
82
 
  (or (not (empty-slot? slot))
83
 
      (= slot 1)
84
 
      (and (not (empty-slot? 1))
85
 
           (deal-cards-face-up 1 (list slot)))
86
 
      (and (not (empty-slot? 0))
87
 
           (deal-cards-face-up 0 (list slot)))
88
 
      #t))
89
 
 
90
 
(define (droppable? start-slot card-list end-slot)
91
 
  (cond ((= start-slot end-slot) #f)
92
 
        ((> end-slot 9)
93
 
         (and (= (length card-list) 1)
94
 
              (not (empty-slot? end-slot))
95
 
              (not (eq? (is-red? (car card-list))
96
 
                        (is-red? (get-top-card end-slot))))
97
 
              (= (get-value (get-top-card end-slot))
98
 
                 (+ 1 (get-value (car card-list))))))
99
 
        ((> end-slot 1)
100
 
         (and (not (eq? (is-red? (get-top-card end-slot))
101
 
                        (is-red? (car card-list))))
102
 
              (= (+ 1 (get-value (get-top-card end-slot)))
103
 
                 (get-value (car card-list)))))
104
 
        (#t #f)))
105
 
 
106
 
(define (button-released start-slot card-list end-slot)
107
 
  (and (droppable? start-slot card-list end-slot)
108
 
       (if (> end-slot 9)
109
 
           (move-n-cards! start-slot end-slot card-list)
110
 
           (begin
111
 
             (move-n-cards! start-slot end-slot (reverse card-list))
112
 
             (add-to-score! (length card-list))))
113
 
       (empty-tableau start-slot)))
114
 
 
115
 
(define (do-deal-next-cards)
116
 
  (flip-stock 0 1 1))
117
 
 
118
 
(define (dealable?)
119
 
  (flippable? 0 1 1))
120
 
 
121
 
(define (button-clicked slot-id)
122
 
  (and (= slot-id 0)
123
 
       (do-deal-next-cards)))
124
 
 
125
 
(define (move-to-foundation slot-id foundation-id)
126
 
  (cond ((= foundation-id 10)
127
 
         #f)
128
 
        ((and (not (eq? (is-red? (get-top-card slot-id))
129
 
                        (is-red? (get-top-card foundation-id))))
130
 
              (= (+ 1 (get-value (get-top-card foundation-id)))
131
 
                 (get-value (get-top-card slot-id))))
132
 
         (and (move-n-cards! slot-id
133
 
                             foundation-id
134
 
                             (list (get-top-card slot-id)))
135
 
              (remove-card slot-id)
136
 
              (empty-tableau slot-id)))
137
 
        (#t (move-to-foundation slot-id (+ 1 foundation-id)))))
138
 
 
139
 
(define (button-double-clicked slot-id)
140
 
  (and (not (empty-slot? slot-id))
141
 
       (or (= slot-id 1)
142
 
           (> slot-id 9))
143
 
       (move-to-foundation slot-id 2)
144
 
       (add-to-score! 1)))
145
 
 
146
 
(define (game-continuable)
147
 
  (give-status-message)
148
 
  (get-hint))
149
 
 
150
 
(define (game-won)
151
 
  (and (= (length (get-cards 2)) 13)
152
 
       (= (length (get-cards 3)) 13)
153
 
       (= (length (get-cards 4)) 13)
154
 
       (= (length (get-cards 5)) 13)
155
 
       (= (length (get-cards 6)) 13)
156
 
       (= (length (get-cards 7)) 13)
157
 
       (= (length (get-cards 8)) 13)
158
 
       (= (length (get-cards 9)) 13)))
159
 
 
160
 
(define (check-a-foundation slot-id foundation-id)
161
 
  (cond ((= foundation-id 10)
162
 
         #f)
163
 
        ((and (not (eq? (is-red? (get-top-card slot-id))
164
 
                        (is-red? (get-top-card foundation-id))))
165
 
              (= (+ 1 (get-value (get-top-card foundation-id)))
166
 
                 (get-value (get-top-card slot-id))))
167
 
         #t)
168
 
        (#t
169
 
         (check-a-foundation slot-id (+ 1 foundation-id)))))
170
 
 
171
 
(define (check-to-foundations slot-id)
172
 
  (cond ((= slot-id 18)
173
 
         #f)
174
 
        ((= slot-id 2)
175
 
         (check-to-foundations 10))
176
 
        ((and (not (empty-slot? slot-id))
177
 
              (check-a-foundation slot-id 2))
178
 
         (list 2 
179
 
               (get-name (get-top-card slot-id)) 
180
 
               (_"the appropriate Foundation pile")))
181
 
        (#t
182
 
         (check-to-foundations (+ 1 slot-id)))))
183
 
 
184
 
(define (check-a-tableau slot1 card-list slot2)
185
 
  (cond ((= slot2 18)
186
 
         #f)
187
 
        ((and (not (= slot1 slot2))
188
 
              (not (eq? (is-red? (car card-list))
189
 
                        (is-red? (get-top-card slot2))))
190
 
              (= (+ 1 (get-value (car card-list)))
191
 
                 (get-value (get-top-card slot2)))
192
 
              (or (= slot1 1)
193
 
                  (= (length card-list) 1)
194
 
                  (check-a-tableau slot1 (cdr card-list) 10)))
195
 
         (list 1
196
 
               (get-name (car card-list))
197
 
               (get-name (get-top-card slot2))))
198
 
        (#t 
199
 
         (check-a-tableau slot1 card-list (+ 1 slot2)))))
200
 
 
201
 
(define (check-to-tableaus slot-id)
202
 
  (cond ((= slot-id 18)
203
 
         #f)
204
 
        ((= slot-id 2)
205
 
         (check-to-tableaus 10))
206
 
        ((and (not (empty-slot? slot-id))
207
 
              (check-a-tableau slot-id (get-cards slot-id) 10))
208
 
         (check-a-tableau slot-id (get-cards slot-id) 10))
209
 
        (#t (check-to-tableaus (+ 1 slot-id)))))
210
 
 
211
 
(define (get-hint)
212
 
  (or (check-to-foundations 1)
213
 
      (check-to-tableaus 1)
214
 
      (or (and (not (empty-slot? 0))
215
 
              (list 0 (_"Deal another round")))
216
 
          (and (not (empty-slot? 1))
217
 
              (< FLIP-COUNTER 1)
218
 
              (list 0 (_"Move waste back to stock"))))))
219
 
 
220
 
(define (get-options) 
221
 
  #f)
222
 
 
223
 
(define (apply-options options) 
224
 
  #f)
225
 
 
226
 
(define (timeout) 
227
 
  #f)
228
 
 
229
 
(set-features droppable-feature dealable-feature)
230
 
 
231
 
(set-lambda new-game button-pressed button-released button-clicked
232
 
button-double-clicked game-continuable game-won get-hint get-options
233
 
apply-options timeout droppable? dealable?)