Commit 7f467548 authored by Vincent Povirk's avatar Vincent Povirk

terrace: Use get-name instead of hint-move.

For bug 551859.
parent 5d5024bb
......@@ -72,20 +72,20 @@
(add-normal-slot (reverse DECK))
(add-normal-slot '())
(add-normal-slot (reverse DECK) 'stock)
(add-normal-slot '() 'waste)
(add-extended-slot '() right)
(add-extended-slot '() right 'reserve)
(add-normal-slot '())
(add-normal-slot '())
(add-normal-slot '())
(add-normal-slot '())
(add-normal-slot '())
(add-normal-slot '())
(add-normal-slot '())
(add-normal-slot '())
(add-normal-slot '() 'foundation)
(add-normal-slot '() 'foundation)
(add-normal-slot '() 'foundation)
(add-normal-slot '() 'foundation)
(add-normal-slot '() 'foundation)
(add-normal-slot '() 'foundation)
(add-normal-slot '() 'foundation)
(add-normal-slot '() 'foundation)
(set! tableau '())
......@@ -103,7 +103,7 @@
(list 8 4.1)
......@@ -111,7 +111,7 @@
(define (build-tableau-slots count)
(and (not (= count 0))
(set! tableau (cons SLOTS tableau))
(add-extended-slot '() down)
(add-extended-slot '() down 'tableau)
(set! HORIZPOS (+ HORIZPOS (- 1 (/ tableau-size 8))))
(build-tableau-slots (- count 1))))
......@@ -164,13 +164,13 @@
(and (= a ace)
(= b king))))
(define (calculate-score slots acc)
(define (calculate-score-helper slots acc)
(if (null? slots)
(calculate-score (cdr slots) (+ acc (length (get-cards (car slots)))))))
(calculate-score-helper (cdr slots) (+ acc (length (get-cards (car slots)))))))
(define (update-score)
(set-score! (calculate-score foundation 0)))
(define (calculate-score)
(set-score! (calculate-score-helper foundation 0)))
(define (do-auto-fill-tableau slots)
(if (null? slots)
......@@ -289,9 +289,7 @@
(and (not (null? end-slots))
(not (empty-slot? start-slot))
(if (droppable? start-slot (list (get-top-card start-slot)) (car end-slots))
(if (empty-slot? (car end-slots))
(list 2 (get-name (get-top-card start-slot)) (_"an empty slot on the foundation"))
(list 1 (get-name (get-top-card start-slot)) (get-name (get-top-card (car end-slots)))))
(hint-move start-slot 1 (car end-slots))
(hint-slot-to-foundation start-slot (cdr end-slots)))))
(define (hint-slots-to-foundation start-slots)
......@@ -311,7 +309,7 @@
; We need to check recursively for builds because it might be possible to free
; a space in the tableau by moving multiple single cards in a row.
(define (buildable-on-tableau start-slot cards acc)
(define (buildable-on-tableau start-slot num-cards cards acc)
(or (and (null? cards)
; If the foundation is building in suit, it's possible that moving cards
......@@ -322,8 +320,9 @@
(and target-slot
(+ num-cards 1)
(cdr cards)
(or acc (list (get-rank (get-value (car cards))) 1 (get-name (car cards)) (get-name (get-top-card target-slot)))))))))
(or acc (cons (get-rank (get-value (car cards))) (hint-move start-slot num-cards target-slot))))))))
(define (buildable-on-tableau-helper start-slot card end-slots)
(and (not (null? end-slots))
(or (and (not (empty-slot? (car end-slots)))
......@@ -345,15 +344,13 @@
(define (hint-tableau-build-helper start-slot)
(and (not (empty-slot? start-slot))
(buildable-on-tableau start-slot (get-cards start-slot) #f)))
(buildable-on-tableau start-slot 1 (get-cards start-slot) #f)))
(define (hint-waste-to-tableau end-slots)
(and (not (null? end-slots))
(not (empty-slot? waste))
(if (droppable? waste (list (get-top-card waste)) (car end-slots))
(if (empty-slot? (car end-slots))
(list 2 (get-name (get-top-card waste)) (_"an empty slot on the tableau"))
(list 1 (get-name (get-top-card waste)) (get-name (get-top-card (car end-slots)))))
(hint-move waste 1 (car end-slots))
(hint-waste-to-tableau (cdr end-slots)))))
(define (hint-deal)
......@@ -374,7 +371,7 @@
(define (game-continuable)
(and (not (game-won))
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