Commit ebc4c597 authored by Rosanna Yuen's avatar Rosanna Yuen Committed by Rosanna Yuen

added info to status bar for most games added checks for game over and


1999-02-24  Rosanna Yuen  <rwsy@mit.edu>

	* added info to status bar for most games
	* spider.scm: added checks for game over and game won, and added
	hint support.
parent d4d9b0d8
1999-02-24 Rosanna Yuen <rwsy@mit.edu>
* added info to status bar for most games
* spider.scm: added checks for game over and game won, and added
hint support.
1999-02-23 Rosanna Yuen <rwsy@mit.edu>
* bristol.scm: added new game
......
......@@ -41,9 +41,15 @@
(add-card! 3 (make-visible (make-card ace heart)))
(add-card! 4 (make-visible (make-card ace spade)))
(set-statusbar-message (get-stock-no-string))
(list 6 2)
)
(define (get-stock-no-string)
(string-append "Stock left: "
(number->string (length (get-cards 0)))))
(define (button-pressed slot-id card-list)
(and (not (empty-slot? slot-id))
(> slot-id 4)))
......@@ -82,6 +88,7 @@
(get-hint)))
(define (game-won)
(set-statusbar-message (get-stock-no-string))
(and (empty-slot? 0)
(empty-slot? 5)
(empty-slot? 6)
......
......@@ -74,8 +74,15 @@
8 9 10 11 12 13 14 15
8 9 10 11 12 13 14 15))
(check-for-kings 8)
(set-statusbar-message (get-stock-no-string))
(list 10 3))
(define (get-stock-no-string)
(string-append "Stock left: "
(number->string (length (get-cards 0)))))
(define (check-for-kings slot-id)
(if (> slot-id 15)
#f
......@@ -140,6 +147,7 @@
#f)
(define (game-continuable)
(set-statusbar-message (get-stock-no-string))
(and (not (game-won))
(get-hint)))
......
......@@ -64,9 +64,17 @@
(add-normal-slot '()) ; Slot 17
(set! add-stage #t)
(set! fill-count 0)
(set-statusbar-message (get-stock-no-string))
(list 6 4)
)
(define (get-stock-no-string)
(string-append "Stock left: "
(number->string (length (get-cards 16)))))
(define (button-pressed slot-id card-list)
(and (not (empty-slot? slot-id))
(if (= slot-id 17)
......@@ -200,6 +208,7 @@
(#t "an empty slot")))
(define (game-over)
(set-statusbar-message (get-stock-no-string))
(if (or (= fill-count 16)
(and (empty-slot? 16) (empty-slot? 17)))
(begin
......
......@@ -51,13 +51,39 @@
(set! BASE-VAL (get-value (get-top-card 2)))
;(set-statusbar-message (string-append "Base Card: " (string BASE-VAL)))
(set-statusbar-message (string-append (get-stock-no-string)
" "
(get-reserve-no-string)
" "
(get-base-string)))
(add-to-score! 1)
(list 7 4)
)
(define (get-stock-no-string)
(string-append "Stock left: "
(number->string (length (get-cards 0)))))
(define (get-reserve-no-string)
(string-append "Reserve left: "
(number->string (length (get-cards 6)))))
(define (get-base-string)
(cond ((and (> BASE-VAL 1)
(< BASE-VAL 11))
(string-append "Base Card: " (number->string BASE-VAL)))
((= BASE-VAL 1)
"Base Card: Ace")
((= BASE-VAL 11)
"Base Card: Jack")
((= BASE-VAL 12)
"Base Card: Queen")
((= BASE-VAL 13)
"Base Card: King")
(#t #f)))
(define (button-pressed slot-id card-list)
(if (= slot-id 0)
#f
......@@ -175,6 +201,11 @@
(place-found slot top-card 2)))))
(define (game-over)
(set-statusbar-message (string-append (get-stock-no-string)
" "
(get-reserve-no-string)
" "
(get-base-string)))
(if (and (empty-slot? 0)
(empty-slot? 1)
(empty-slot? 6)
......
......@@ -53,9 +53,15 @@
(add-to-score! 1)
(set-statusbar-message (get-stock-no-string))
(list 6 3)
)
(define (get-stock-no-string)
(string-append "Stock left: "
(number->string (length (get-cards 0)))))
(define (check-kings slot-list)
(if (= (get-value (get-top-card (car slot-list))) king)
(begin
......@@ -124,6 +130,7 @@
#f)))
(define (game-over)
(set-statusbar-message (get-stock-no-string))
(or (< FLIP-COUNTER 2)
(not (empty-slot? 0))
(check-move 1)))
......
......@@ -69,8 +69,37 @@
(add-to-score! 1)
(set! BASE-VAL (get-value (get-top-card 2)))
(set-statusbar-message (string-append (get-stock-no-string)
" "
(get-reserve-no-string)
" "
(get-base-string)))
(list 9 3))
(define (get-stock-no-string)
(string-append "Stock left: "
(number->string (length (get-cards 0)))))
(define (get-reserve-no-string)
(string-append "Reserve left: "
(number->string (length (get-cards 10)))))
(define (get-base-string)
(cond ((and (> BASE-VAL 1)
(< BASE-VAL 11))
(string-append "Base Card: " (number->string BASE-VAL)))
((= BASE-VAL 1)
"Base Card: Ace")
((= BASE-VAL 11)
"Base Card: Jack")
((= BASE-VAL 12)
"Base Card: Queen")
((= BASE-VAL 13)
"Base Card: King")
(#t #f)))
(define (button-pressed slot-id card-list)
(and card-list
(not (member slot-id '(2 3 4 5)))
......@@ -83,7 +112,12 @@
(if (and (not (= start-slot 1))
(empty-slot? start-slot)
(not (empty-slot? 10)))
(deal-cards-face-up 10 (cons start-slot '()))))
(deal-cards-face-up 10 (cons start-slot '())))
(set-statusbar-message (string-append (get-stock-no-string)
" "
(get-reserve-no-string)
" "
(get-base-string))))
(define (button-released start-slot card-list end-slot)
(and (not (= start-slot end-slot))
......@@ -113,7 +147,14 @@
(define (button-clicked slot-id)
(if (= slot-id 0)
(flip-stock 0 1 2)))
(begin
(flip-stock 0 1 2)
(set-statusbar-message (string-append (get-stock-no-string)
" "
(get-reserve-no-string)
" "
(get-base-string))))
#f))
(define (button-double-clicked slot)
(if (and (not (empty-slot? slot))
......
......@@ -85,9 +85,15 @@
(deal-cards 0 '(2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22))
(deal-cards-face-up 0 '(23 24 25 26 27 28 29))
(set-statusbar-message (get-stock-no-string))
(list 5 4)
)
(define (get-stock-no-string)
(string-append "Stock left: "
(number->string (length (get-cards 0)))))
(define (button-pressed slot-id card-list)
(and (is-visible? (car card-list))
(not (= slot-id 1))))
......@@ -321,6 +327,7 @@
(playable? (+ 1 check-slot)))))
(define (game-continuable)
(set-statusbar-message (get-stock-no-string))
(and (not (game-won))
(get-hint)))
......
......@@ -31,9 +31,15 @@
(add-extended-slot '() down)
(add-extended-slot '() down)
(set-statusbar-message (get-stock-no-string))
(list 6 3)
)
(define (get-stock-no-string)
(string-append "Stock left: "
(number->string (length (get-cards 0)))))
(define (button-pressed slot-id card-list)
(and card-list
(> slot-id 0)
......@@ -95,6 +101,7 @@
(= 1 (length (get-cards 4)))))
(define (game-over)
(set-statusbar-message (get-stock-no-string))
(not (and (empty-slot? 0)
(and (not (empty-slot? 1))
(not (empty-slot? 2))
......
......@@ -44,8 +44,13 @@
(add-card! 4 (make-visible (make-card 3 club)))
(add-card! 5 (make-visible (make-card 4 club)))
(set-statusbar-message (get-stock-no-string))
(list 7 4))
(define (get-stock-no-string)
(string-append "Stock left: "
(number->string (length (get-cards 0)))))
(define (button-pressed slot-id card-list)
(and (not (empty-slot? slot-id))
......@@ -102,6 +107,7 @@
#f)
(define (game-continuable)
(set-statusbar-message (get-stock-no-string))
(and (not (game-won))
(get-hint)))
......
......@@ -55,9 +55,15 @@
(map flip-top-card tableau)
(set-statusbar-message (get-stock-no-string))
(list 7 3)
)
(define (get-stock-no-string)
(string-append "Stock left: "
(number->string (length (get-cards 0)))))
(define (button-pressed slot-id card-list)
(and (or (> slot-id 1)
(and (= slot-id 1)
......@@ -211,6 +217,7 @@
; so we must NOT report game-over when they run out.
(define (game-over)
(set-statusbar-message (get-stock-no-string))
(not (game-won)))
(define (get-options)
......
......@@ -64,9 +64,15 @@
(deal-cards-face-up 0 '(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18
19 20 21 22 23 24 25))
(set-statusbar-message (get-stock-no-string))
(list 6 5)
)
(define (get-stock-no-string)
(string-append "Stock left: "
(number->string (length (get-cards 0)))))
(define (button-pressed slot-id card-list)
(and (not (= slot-id 0))
(not (empty-slot? slot-id))))
......@@ -170,6 +176,7 @@
(empty-slot? 1))
(define (game-over)
(set-statusbar-message (get-stock-no-string))
(and (not (game-won))
(get-hint)))
......
......@@ -44,9 +44,16 @@
(deal-cards 8 '(0 2 4 6 0 2 4 6 0 2 4 6))
(deal-cards-face-up 8 '(0 2 4 6 1))
(set-statusbar-message (get-stock-no-string))
(add-to-score! 1)
(list 6 5)
)
(define (get-stock-no-string)
(string-append "Stock left: "
(number->string (length (get-cards 8)))))
(define (button-pressed slot-id card-list)
(and (not (empty-slot? slot-id))
......@@ -166,6 +173,7 @@
(get-valid-move (cdr id-list)))))
(define (game-over)
(set-statusbar-message (get-stock-no-string))
(or (and (< FLIP-COUNTER 3)
(not (empty-slot? 9)))
(not (empty-slot? 8))
......
......@@ -41,9 +41,15 @@
(add-card! 3 (make-visible (make-card ace heart)))
(add-card! 4 (make-visible (make-card ace spade)))
(set-statusbar-message (get-stock-no-string))
(list 6 2)
)
(define (get-stock-no-string)
(string-append "Stock left: "
(number->string (length (get-cards 0)))))
(define (button-pressed slot-id card-list)
(and (not (empty-slot? slot-id))
(> slot-id 4)))
......@@ -82,6 +88,7 @@
(get-hint)))
(define (game-won)
(set-statusbar-message (get-stock-no-string))
(and (empty-slot? 0)
(empty-slot? 5)
(empty-slot? 6)
......
......@@ -74,8 +74,15 @@
8 9 10 11 12 13 14 15
8 9 10 11 12 13 14 15))
(check-for-kings 8)
(set-statusbar-message (get-stock-no-string))
(list 10 3))
(define (get-stock-no-string)
(string-append "Stock left: "
(number->string (length (get-cards 0)))))
(define (check-for-kings slot-id)
(if (> slot-id 15)
#f
......@@ -140,6 +147,7 @@
#f)
(define (game-continuable)
(set-statusbar-message (get-stock-no-string))
(and (not (game-won))
(get-hint)))
......
......@@ -64,9 +64,17 @@
(add-normal-slot '()) ; Slot 17
(set! add-stage #t)
(set! fill-count 0)
(set-statusbar-message (get-stock-no-string))
(list 6 4)
)
(define (get-stock-no-string)
(string-append "Stock left: "
(number->string (length (get-cards 16)))))
(define (button-pressed slot-id card-list)
(and (not (empty-slot? slot-id))
(if (= slot-id 17)
......@@ -200,6 +208,7 @@
(#t "an empty slot")))
(define (game-over)
(set-statusbar-message (get-stock-no-string))
(if (or (= fill-count 16)
(and (empty-slot? 16) (empty-slot? 17)))
(begin
......
......@@ -51,13 +51,39 @@
(set! BASE-VAL (get-value (get-top-card 2)))
;(set-statusbar-message (string-append "Base Card: " (string BASE-VAL)))
(set-statusbar-message (string-append (get-stock-no-string)
" "
(get-reserve-no-string)
" "
(get-base-string)))
(add-to-score! 1)
(list 7 4)
)
(define (get-stock-no-string)
(string-append "Stock left: "
(number->string (length (get-cards 0)))))
(define (get-reserve-no-string)
(string-append "Reserve left: "
(number->string (length (get-cards 6)))))
(define (get-base-string)
(cond ((and (> BASE-VAL 1)
(< BASE-VAL 11))
(string-append "Base Card: " (number->string BASE-VAL)))
((= BASE-VAL 1)
"Base Card: Ace")
((= BASE-VAL 11)
"Base Card: Jack")
((= BASE-VAL 12)
"Base Card: Queen")
((= BASE-VAL 13)
"Base Card: King")
(#t #f)))
(define (button-pressed slot-id card-list)
(if (= slot-id 0)
#f
......@@ -175,6 +201,11 @@
(place-found slot top-card 2)))))
(define (game-over)
(set-statusbar-message (string-append (get-stock-no-string)
" "
(get-reserve-no-string)
" "
(get-base-string)))
(if (and (empty-slot? 0)
(empty-slot? 1)
(empty-slot? 6)
......
......@@ -53,9 +53,15 @@
(add-to-score! 1)
(set-statusbar-message (get-stock-no-string))
(list 6 3)
)
(define (get-stock-no-string)
(string-append "Stock left: "
(number->string (length (get-cards 0)))))
(define (check-kings slot-list)
(if (= (get-value (get-top-card (car slot-list))) king)
(begin
......@@ -124,6 +130,7 @@
#f)))
(define (game-over)
(set-statusbar-message (get-stock-no-string))
(or (< FLIP-COUNTER 2)
(not (empty-slot? 0))
(check-move 1)))
......
......@@ -69,8 +69,37 @@
(add-to-score! 1)
(set! BASE-VAL (get-value (get-top-card 2)))
(set-statusbar-message (string-append (get-stock-no-string)
" "
(get-reserve-no-string)
" "
(get-base-string)))
(list 9 3))
(define (get-stock-no-string)
(string-append "Stock left: "
(number->string (length (get-cards 0)))))
(define (get-reserve-no-string)
(string-append "Reserve left: "
(number->string (length (get-cards 10)))))
(define (get-base-string)
(cond ((and (> BASE-VAL 1)
(< BASE-VAL 11))
(string-append "Base Card: " (number->string BASE-VAL)))
((= BASE-VAL 1)
"Base Card: Ace")
((= BASE-VAL 11)
"Base Card: Jack")
((= BASE-VAL 12)
"Base Card: Queen")
((= BASE-VAL 13)
"Base Card: King")
(#t #f)))
(define (button-pressed slot-id card-list)
(and card-list
(not (member slot-id '(2 3 4 5)))
......@@ -83,7 +112,12 @@
(if (and (not (= start-slot 1))
(empty-slot? start-slot)
(not (empty-slot? 10)))
(deal-cards-face-up 10 (cons start-slot '()))))
(deal-cards-face-up 10 (cons start-slot '())))
(set-statusbar-message (string-append (get-stock-no-string)
" "
(get-reserve-no-string)
" "
(get-base-string))))
(define (button-released start-slot card-list end-slot)
(and (not (= start-slot end-slot))
......@@ -113,7 +147,14 @@
(define (button-clicked slot-id)
(if (= slot-id 0)
(flip-stock 0 1 2)))
(begin
(flip-stock 0 1 2)
(set-statusbar-message (string-append (get-stock-no-string)
" "
(get-reserve-no-string)
" "
(get-base-string))))
#f))
(define (button-double-clicked slot)
(if (and (not (empty-slot? slot))
......
......@@ -85,9 +85,15 @@
(deal-cards 0 '(2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22))
(deal-cards-face-up 0 '(23 24 25 26 27 28 29))
(set-statusbar-message (get-stock-no-string))
(list 5 4)
)
(define (get-stock-no-string)
(string-append "Stock left: "
(number->string (length (get-cards 0)))))
(define (button-pressed slot-id card-list)
(and (is-visible? (car card-list))
(not (= slot-id 1))))
......@@ -321,6 +327,7 @@
(playable? (+ 1 check-slot)))))
(define (game-continuable)
(set-statusbar-message (get-stock-no-string))
(and (not (game-won))
(get-hint)))
......
......@@ -31,9 +31,15 @@
(add-extended-slot '() down)
(add-extended-slot '() down)
(set-statusbar-message (get-stock-no-string))
(list 6 3)
)
(define (get-stock-no-string)
(string-append "Stock left: "
(number->string (length (get-cards 0)))))
(define (button-pressed slot-id card-list)
(and card-list
(> slot-id 0)
......@@ -95,6 +101,7 @@
(= 1 (length (get-cards 4)))))
(define (game-over)
(set-statusbar-message (get-stock-no-string))
(not (and (empty-slot? 0)
(and (not (empty-slot? 1))
(not (empty-slot? 2))
......
......@@ -44,8 +44,13 @@
(add-card! 4 (make-visible (make-card 3 club)))
(add-card! 5 (make-visible (make-card 4 club)))
(set-statusbar-message (get-stock-no-string))
(list 7 4))
(define (get-stock-no-string)
(string-append "Stock left: "
(number->string (length (get-cards 0)))))
(define (button-pressed slot-id card-list)
(and (not (empty-slot? slot-id))
......@@ -102,6 +107,7 @@
#f)
(define (game-continuable)
(set-statusbar-message (get-stock-no-string))
(and (not (game-won))
(get-hint)))
......
......@@ -55,9 +55,15 @@
(map flip-top-card tableau)
(set-statusbar-message (get-stock-no-string))
(list 7 3)
)
(define (get-stock-no-string)
(string-append "Stock left: "
(number->string (length (get-cards 0)))))
(define (button-pressed slot-id card-list)
(and (or (> slot-id 1)
(and (= slot-id 1)
......@@ -211,6 +217,7 @@
; so we must NOT report game-over when they run out.
(define (game-over)
(set-statusbar-message (get-stock-no-string))
(not (game-won)))
(define (get-options)
......
......@@ -64,9 +64,15 @@
(deal-cards-face-up 0 '(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18
19 20 21 22 23 24 25))
(set-statusbar-message (get-stock-no-string))
(list 6 5)
)
(define (get-stock-no-string)
(string-append "Stock left: "
(number->string (length (get-cards 0)))))
(define (button-pressed slot-id card-list)
(and (not (= slot-id 0))
(not (empty-slot? slot-id))))
......@@ -170,6 +176,7 @@
(empty-slot? 1))
(define (game-over)
(set-statusbar-message (get-stock-no-string))
(and (not (game-won))
(get-hint)))
......
......@@ -44,9 +44,16 @@
(deal-cards 8 '(0 2 4 6 0 2 4 6 0 2 4 6))
(deal-cards-face-up 8 '(0 2 4 6 1))
(set-statusbar-message (get-stock-no-string))
(add-to-score! 1)
(list 6 5)
)
(define (get-stock-no-string)
(string-append "Stock left: "
(number->string (length (get-cards 8)))))
(define (button-pressed slot-id card-list)
(and (not (empty-slot? slot-id))
......@@ -166,6 +173,7 @@
(get-valid-move (cdr id-list)))))
(define (game-over)
(set-statusbar-message (get-stock-no-string))
(or (and (< FLIP-COUNTER 3)
(not (empty-slot? 9)))
(not (empty-slot? 8))
......
......@@ -48,8 +48,16 @@
(add-extended-slot '() down)
(add-extended-slot '() down)
(deal-initial-setup)