← Back to branch summary

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

« back to all changes in this revision

Viewing changes to aisleriot/rules/hopscotch.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/hopscotch.scm
1
 
; AisleRiot - hopscotch.scm
2
 
; Copyright (C) 1999 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 (make-deck-list-ace-low 1 5 club))
21
 
  (shuffle-deck)
22
 
 
23
 
  (add-normal-slot DECK)
24
 
  (add-normal-slot '())
25
 
 
26
 
  (add-blank-slot)
27
 
  (add-normal-slot '())
28
 
  (add-normal-slot '())
29
 
  (add-normal-slot '())
30
 
  (add-normal-slot '())
31
 
  (add-carriage-return-slot)
32
 
  (add-blank-slot)
33
 
  (add-blank-slot)
34
 
  (add-blank-slot)
35
 
  (add-extended-slot '() down)
36
 
  (add-extended-slot '() down)
37
 
  (add-extended-slot '() down)
38
 
  (add-extended-slot '() down)
39
 
 
40
 
  (add-card! 2 (make-visible (make-card ace club)))
41
 
  (add-card! 3 (make-visible (make-card 2 club)))
42
 
  (add-card! 4 (make-visible (make-card 3 club)))
43
 
  (add-card! 5 (make-visible (make-card 4 club)))
44
 
 
45
 
  (give-status-message)
46
 
 
47
 
  (list 7 4))
48
 
 
49
 
(define (give-status-message)
50
 
  (set-statusbar-message (get-stock-no-string)))
51
 
 
52
 
(define (get-stock-no-string)
53
 
  (string-append (_"Stock left:") " " 
54
 
                 (number->string (length (get-cards 0)))))
55
 
 
56
 
(define (button-pressed slot-id card-list)
57
 
  (and (not (empty-slot? slot-id))
58
 
       (= (length card-list) 1)
59
 
       (or (= slot-id 1)
60
 
           (> slot-id 5))))         
61
 
 
62
 
(define (droppable? start-slot card-list end-slot)
63
 
  (cond ((and (> end-slot 1)
64
 
              (< end-slot 6))
65
 
         (= (modulo (get-value (car card-list)) 13)
66
 
            (modulo (+ (- end-slot 1) (get-value (get-top-card end-slot))) 13)))
67
 
        ((and (= start-slot 1)
68
 
              (>= end-slot 6))
69
 
         #t)
70
 
        (#t #f)))
71
 
 
72
 
(define (button-released start-slot card-list end-slot)
73
 
  (if (droppable? start-slot card-list end-slot)
74
 
      (begin
75
 
        (move-n-cards! start-slot end-slot card-list)
76
 
        (if (and (> end-slot 1) (< end-slot 6))
77
 
            (add-to-score! 1)
78
 
            #t))
79
 
      #f))
80
 
 
81
 
(define (button-clicked slot-id)
82
 
  (and (= slot-id 0)
83
 
       (empty-slot? 1)
84
 
       (flip-stock 0 1 1)))
85
 
 
86
 
(define (button-double-clicked slot-id)
87
 
  #f)
88
 
 
89
 
(define (game-continuable)
90
 
  (give-status-message)
91
 
  (and (not (game-won))
92
 
       (get-hint)))
93
 
 
94
 
(define (game-won)
95
 
  (and (empty-slot? 0)
96
 
       (empty-slot? 1)
97
 
       (empty-slot? 6)
98
 
       (empty-slot? 7)
99
 
       (empty-slot? 8)
100
 
       (empty-slot? 9)))
101
 
 
102
 
(define (check-to-foundation slot-id foundation-id)
103
 
  (cond ((or (> slot-id 9)
104
 
             (and (> slot-id 1)
105
 
                  (< slot-id 6)))
106
 
         #f)
107
 
        ((> foundation-id 5)
108
 
         (check-to-foundation (+ 1 slot-id) 2))
109
 
        ((or (empty-slot?  slot-id)
110
 
             (and (not (empty-slot? foundation-id))
111
 
                  (= (get-value (get-top-card foundation-id)) 13))
112
 
             (not (= (modulo (get-value (get-top-card slot-id)) 13)
113
 
                     (modulo (+ (- foundation-id 1) 
114
 
                                (get-value (get-top-card foundation-id)))
115
 
                             13))))
116
 
         (check-to-foundation slot-id (+ 1 foundation-id)))
117
 
        (#t (list 1 
118
 
                  (get-name (get-top-card slot-id))
119
 
                  (get-name (get-top-card foundation-id))))))
120
 
 
121
 
(define (check-waste)
122
 
  (cond ((empty-slot? 1)
123
 
         #f)
124
 
        ((check-to-foundation 1 2)
125
 
         (check-to-foundation 1 2))
126
 
        (#t (list 0 (_"Move card from waste")))))
127
 
 
128
 
(define (dealable?)
129
 
  (and (not (empty-slot? 0))
130
 
       (list 0 (_"Deal another card"))))
131
 
 
132
 
(define (get-hint)
133
 
  (or (check-to-foundation 6 2)
134
 
      (check-waste)
135
 
      (dealable?)))
136
 
 
137
 
(define (get-options) 
138
 
  #f)
139
 
 
140
 
(define (apply-options options) 
141
 
  #f)
142
 
 
143
 
(define (timeout) 
144
 
  #f)
145
 
 
146
 
(set-features droppable-feature)
147
 
 
148
 
(set-lambda new-game button-pressed button-released button-clicked
149
 
button-double-clicked game-continuable game-won get-hint get-options
150
 
apply-options timeout droppable?)
151