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

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

parent ae69f501
......@@ -72,6 +72,7 @@
(set! HISTORY '())
(set! FOUNDATION-SLOTS '())
(set! TABLEAU-SLOTS '())
(set! RESERVE-SLOTS '())
(set! EDGE-SLOTS '())
(set! CORNER-SLOTS '())
(set! TOP-SLOTS '())
......@@ -319,6 +320,14 @@
(define-public (find-card slot card)
(find-card-helper card (get-cards slot) 1))
(define (find-card-slot-helper slot card)
(if (equal? #f (find-card slot card))
(find-card-slot-helper (+ 1 slot) card)
slot))
(define-public (find-card-slot card)
(find-card-slot-helper 0 card))
; Get the nth card from a slot. Returns #f if n is out of range.
(define-public (get-nth-card slot-id n)
(let ((cards (get-cards slot-id)))
......@@ -463,6 +472,7 @@
(if (empty-slot? to-slot)
(cond ((member to-slot FOUNDATION-SLOTS) (if (= (length FOUNDATION-SLOTS) 1) (_"Move ~a onto the foundation.") (_"Move ~a onto an empty foundation slot.")))
((member to-slot TABLEAU-SLOTS) (if (= (length TABLEAU-SLOTS) 1) (_"Move ~a onto the tableau.") (_"Move ~a onto an empty tableau slot.")))
((member to-slot RESERVE-SLOTS) (if (= (length RESERVE-SLOTS) 1) (_"Move ~a onto the reserve.") (_"Move ~a onto an empty reserve slot.")))
((member to-slot EDGE-SLOTS) (_"Move ~a onto an empty edge slot."))
((member to-slot CORNER-SLOTS) (_"Move ~a onto an empty corner slot."))
((member to-slot TOP-SLOTS) (_"Move ~a onto an empty top slot."))
......@@ -598,6 +608,7 @@
(define-public (set-tag! slot)
(case (cadddr slot)
((tableau) (set! TABLEAU-SLOTS (cons SLOTS TABLEAU-SLOTS)))
((reserve) (set! RESERVE-SLOTS (cons SLOTS RESERVE-SLOTS)))
((edge) (set! EDGE-SLOTS (cons SLOTS EDGE-SLOTS)))
((corner) (set! CORNER-SLOTS (cons SLOTS CORNER-SLOTS)))
((top) (set! TOP-SLOTS (cons SLOTS TOP-SLOTS)))
......@@ -646,6 +657,7 @@
(define-public IN-GAME #f)
(define-public FOUNDATION-SLOTS '())
(define-public TABLEAU-SLOTS '())
(define-public RESERVE-SLOTS '())
(define-public EDGE-SLOTS '())
(define-public CORNER-SLOTS '())
(define-public TOP-SLOTS '())
......
......@@ -629,11 +629,14 @@
(to-stack (vector-ref board to-slot)))
(if (eq? (vector-ref (cdar best-move) index-outcome) outcome-lose)
(list 0 (_"The game has no solution. Undo or start again."))
(list 1 (get-name from-card)
(cond ((freecell? to-slot) (_"an empty reserve"))
((homecell? to-slot) (_"the foundation"))
((null? to-stack) (_"an open tableau"))
(else (get-name (car to-stack)))))))))
(hint-move (find-card-slot from-card) (find-card (find-card-slot from-card) from-card)
(cond ((freecell? to-slot) (find-empty-slot freecells))
((homecell? to-slot)
(if (equal? 0 to-stack)
(find-empty-slot homecells)
(find-card-slot (list to-stack (get-suit from-card) #t))))
((null? to-stack) (find-empty-slot fields))
(else (find-card-slot (car to-stack)))))))))
; Returns a vector copy of the master board for use as the initial
; node in the search.
......
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