Commit 6836aeb6 authored by Vincent Povirk's avatar Vincent Povirk

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

For bug 677197.
parent 1bc159bc
......@@ -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))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment