[aisleriot] scorpion: Don't use separate state to calculate score and win condition.



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]