[aisleriot] scorpion: Don't use separate state to calculate score and win condition.
- From: Vincent Povirk <vpovirk src gnome org>
- To: commits-list gnome org
- Cc:
- Subject: [aisleriot] scorpion: Don't use separate state to calculate score and win condition.
- Date: Sun, 24 Nov 2013 21:35:23 +0000 (UTC)
commit 6836aeb64f9af6673cb60e8c1e10d091c7308685
Author: Vincent Povirk <madewokherd gmail com>
Date: Sun Nov 24 15:28:25 2013 -0600
scorpion: Don't use separate state to calculate score and win condition.
For bug 677197.
games/scorpion.scm | 90 +++++++++++++++++++++++++---------------------------
1 files changed, 43 insertions(+), 47 deletions(-)
---
diff --git a/games/scorpion.scm b/games/scorpion.scm
index 35131ba..1eb1547 100644
--- a/games/scorpion.scm
+++ b/games/scorpion.scm
@@ -48,28 +48,36 @@
(deal-cards-face-up 0 '(1 2 3 4 5 6 7))
(deal-cards-face-up 0 '(1 2 3 4 5 6 7))
- (begin-score (reverse (get-cards 1)))
- (begin-score (reverse (get-cards 2)))
- (begin-score (reverse (get-cards 3)))
- (begin-score (reverse (get-cards 4)))
- (begin-score (reverse (get-cards 5)))
- (begin-score (reverse (get-cards 6)))
- (begin-score (reverse (get-cards 7)))
+ (check-score)
(list 9 4))
-(define (begin-score card-list)
- (if (not (is-visible? (car card-list)))
- (begin-score (cdr card-list))
- (begin
- (if (and (= (get-suit (car card-list))
- (get-suit (cadr card-list)))
- (= (get-value (car card-list))
- (+ (get-value (cadr card-list)) 1)))
- (add-to-score! 1))
- (if (> (length card-list) 2)
- (begin-score (cdr card-list))
- #f))))
+(define (check-score-cards acc cards unbroken count)
+ (cond
+ ((null? cards)
+ (if (and unbroken (= count 13))
+ (+ acc 4)
+ acc))
+ ((not (is-visible? (car cards)))
+ (check-score-cards (- acc 3) (cdr cards) #f (+ count 1)))
+ ((or (null? (cdr cards))
+ (not (is-visible? (cadr cards))))
+ (check-score-cards acc (cdr cards) unbroken (+ count 1)))
+ ((and (= (get-suit (car cards))
+ (get-suit (cadr cards)))
+ (= (+ 1 (get-value (car cards)))
+ (get-value (cadr cards))))
+ (check-score-cards (+ acc 1) (cdr cards) unbroken (+ count 1)))
+ (#t
+ (check-score-cards acc (cdr cards) #f (+ count 1)))))
+
+(define (check-score-slot acc slots)
+ (if (null? slots)
+ acc
+ (check-score-slot (check-score-cards acc (get-cards (car slots)) #t 0) (cdr slots))))
+
+(define (check-score)
+ (set-score! (check-score-slot 36 tableau)))
(define (button-pressed slot-id card-list)
(and (not (empty-slot? slot-id))
@@ -97,40 +105,16 @@
(define (button-released start-slot card-list end-slot)
(and (droppable? start-slot card-list end-slot)
- (or (empty-slot? end-slot)
- (add-to-score! 1))
(move-n-cards! start-slot end-slot card-list)
(or (empty-slot? start-slot)
- (is-visible? (get-top-card start-slot))
- (and (make-visible-top-card start-slot)
- (add-to-score! 3)))
- (or (not (= (length (get-cards end-slot)) 13))
- (not (correct-sequence (get-cards end-slot)))
- (and (= (length card-list) 13)
- (empty-slot? start-slot))
- (add-to-score! 4))
- (or (not (= (length (get-cards start-slot)) 13))
- (not (correct-sequence (get-cards start-slot)))
- (add-to-score! 4))))
-
-(define (check-for-points slot-id)
- (if (> slot-id 3)
- (give-status-message)
- (begin
- (if (and (> (length (get-cards slot-id)) 1)
- (eq? (get-suit (get-top-card slot-id))
- (get-suit (cadr (get-cards slot-id))))
- (= (+ 1 (get-value (get-top-card slot-id)))
- (get-value (cadr (get-cards slot-id)))))
- (add-to-score! 1)
- #t)
- (check-for-points (+ 1 slot-id)))))
+ (make-visible-top-card start-slot))
+ (check-score)))
(define (button-clicked slot-id)
(and (= slot-id 0)
(not (empty-slot? 0))
(deal-cards-face-up 0 '(1 2 3))
- (check-for-points 1)))
+ (check-score)))
(define (button-double-clicked slot-id)
#f)
@@ -138,8 +122,20 @@
(define (game-continuable)
(get-hint))
+(define (slots-filled? slots)
+ (cond
+ ((null? slots)
+ #t)
+ ((empty-slot? (car slots))
+ (slots-filled? (cdr slots)))
+ ((and (= 13 (length (get-cards (car slots))))
+ (correct-sequence (get-cards (car slots))))
+ (slots-filled? (cdr slots)))
+ (#t
+ #f)))
+
(define (game-won)
- (eq? (get-score) 100))
+ (slots-filled? tableau))
(define (dealable?)
(and (not (empty-slot? 0))
[
Date Prev][
Date Next] [
Thread Prev][
Thread Next]
[
Thread Index]
[
Date Index]
[
Author Index]