218 lines
8.2 KiB
Racket
218 lines
8.2 KiB
Racket
#lang scheme/gui
|
|
|
|
(require htdp/error
|
|
lang/prim
|
|
mzlib/unitsig
|
|
mzlib/etc
|
|
mzlib/class
|
|
mzlib/list)
|
|
|
|
(provide
|
|
guess-with-gui
|
|
guess-with-gui-3
|
|
guess-with-gui-list
|
|
)
|
|
|
|
(define-higher-order-primitive guess-with-gui guess-with-gui/proc
|
|
(check-guess))
|
|
(define-higher-order-primitive guess-with-gui-3 guess-with-gui-3/proc
|
|
(check-guess))
|
|
(define-higher-order-primitive guess-with-gui-list guess-with-gui-list/proc
|
|
(_ check-guess-list))
|
|
|
|
|
|
;
|
|
;
|
|
;
|
|
; ;;;;
|
|
; ; ;
|
|
; ; ; ;
|
|
; ; ;;;; ; ;;; ;;;; ;;;; ;;; ; ;;; ;;;; ;;;;
|
|
; ; ; ; ;; ; ; ; ; ; ;; ; ; ;
|
|
; ; ; ; ; ; ; ; ; ; ; ; ;
|
|
; ; ; ; ; ; ;;; ; ;;;; ; ; ; ;;;
|
|
; ; ; ; ; ; ; ; ; ; ; ; ; ;
|
|
; ; ; ; ; ; ; ; ; ; ; ; ; ; ;
|
|
; ;;;; ;;;; ; ; ;;;; ;; ;;;;; ; ; ;; ;;;;
|
|
;
|
|
;
|
|
;
|
|
|
|
(define TITLE "Bobby's Game")
|
|
|
|
(define WELCOME "Welcome to Bobby's Game")
|
|
|
|
(define DIGITS (build-list 10 (lambda (i) (number->string i))))
|
|
|
|
(define BUT-SIZE 10)
|
|
|
|
(define WIDTH BUT-SIZE) ; (* 5 BUT-SIZE)
|
|
|
|
(define HIGHT BUT-SIZE)
|
|
|
|
(define STOPS (list 'Perfect 'perfect 'perfect! 'perfect_guess))
|
|
|
|
(define TRUMPET
|
|
(make-object bitmap%
|
|
(build-path (collection-path "icons") "trumpet.xbm")
|
|
'xbm))
|
|
|
|
|
|
;
|
|
;
|
|
;
|
|
; ;;;;
|
|
; ; ;
|
|
; ;
|
|
; ; ;;; ; ;;; ;; ;;;
|
|
; ; ; ; ;; ;; ; ; ;
|
|
; ; ; ; ; ; ; ;
|
|
; ; ; ;;;; ; ; ; ;;;;;
|
|
; ; ; ; ; ; ; ; ;
|
|
; ; ; ; ; ; ; ; ;
|
|
; ;;;;; ;;;;; ; ; ; ;;;;
|
|
;
|
|
;
|
|
;
|
|
|
|
|
|
|
|
#| ------------------------------------------------------------------------
|
|
|
|
------------------------------------------------------------------
|
|
|
|
|
| CB1 CB2 CB3 CB4 ....... CB* CB* CB* CB* CB*
|
|
|
|
|
| CB-GUESS1 ... CB-GUESS*
|
|
|
|
|
| ONE-MESSAGE
|
|
------------------------------------------------------------------
|
|
|
|
Two horizontal panels:
|
|
the first one with all the colors (as buttons)
|
|
the second is a sequence of colored buttons
|
|
|#
|
|
|
|
;; ------------------------------------------------------------------------
|
|
;; Setting up the buttons
|
|
|
|
(define (init-game number-of-digits convert check-guess)
|
|
(local ((define GUESS number-of-digits)
|
|
|
|
;; layout
|
|
(define frame (make-object frame% TITLE #f WIDTH HIGHT))
|
|
|
|
(define verti (make-object vertical-panel% frame))
|
|
|
|
(define panel
|
|
(let ([panel (make-object horizontal-panel% verti)])
|
|
(send panel set-alignment 'center 'center)
|
|
panel))
|
|
|
|
(define guess-panel
|
|
(let ([guess-panel (make-object horizontal-panel% verti)])
|
|
(send guess-panel set-alignment 'center 'center)
|
|
guess-panel))
|
|
|
|
(define message-panel
|
|
(let ([message-panel (make-object horizontal-panel% verti)])
|
|
(send message-panel set-alignment 'center 'center)
|
|
message-panel))
|
|
|
|
;; message : a field for displaying basic messages about state of game
|
|
(define message (make-object message% WELCOME message-panel))
|
|
|
|
;; guesses: status vector, record the choice of digit when set
|
|
(define guesses (make-vector GUESS 0))
|
|
|
|
;; the-number : randomly chosen
|
|
(define the-number 0)
|
|
|
|
;; new-game : -> void
|
|
;; effect: set up new target number, send message that game's ready
|
|
(define (new-game)
|
|
(set! the-number (random (expt 10 GUESS)))
|
|
(send message-panel change-children (lambda (x) (list message)))
|
|
(send message set-label WELCOME))
|
|
|
|
;; call-back : _ _ -> void
|
|
;; check status and announce result, possibly set winner
|
|
(define (call-back x y)
|
|
(let ((response (check-guess (convert guesses) the-number)))
|
|
(send message set-label (symbol->string response))
|
|
(when (memq response STOPS)
|
|
;; announce winner and set up new game
|
|
(send message-panel change-children (lambda (x) empty))
|
|
(make-object message% TRUMPET message-panel)
|
|
(make-object button% "New Game?" message-panel
|
|
(lambda (x y) (new-game)))
|
|
(make-object button% "CLOSE?" message-panel
|
|
(lambda (x y) (send frame show #f)))))))
|
|
|
|
;; making the menu choices
|
|
(for-each (lambda (i)
|
|
(local ((define n (- GUESS i 1)))
|
|
(make-object choice% #f DIGITS panel
|
|
(lambda (x y)
|
|
(vector-set! guesses n (send x get-selection))))))
|
|
(build-list GUESS identity))
|
|
|
|
(new-game)
|
|
(make-object button% "Check" guess-panel call-back)
|
|
(send frame show #t)
|
|
#t))
|
|
|
|
|
|
;
|
|
;
|
|
;
|
|
; ;;;;;
|
|
; ;
|
|
; ; ;
|
|
; ; ; ; ; ;;; ;;;; ; ;;;;;; ;;;;
|
|
; ;;;; ; ; ;; ; ; ; ;; ; ;
|
|
; ; ; ; ; ; ; ; ; ; ;
|
|
; ; ; ; ; ; ; ; ; ;;;
|
|
; ; ; ; ; ; ; ; ; ; ;
|
|
; ; ; ; ;; ; ; ; ; ; ;
|
|
; ;;;;; ; ; ; ;;; ;;;; ; ;; ;;;;
|
|
; ;
|
|
; ;
|
|
; ;
|
|
|
|
|
|
;; convert : (vector DIGIT) -> number
|
|
;; to convert a vector of digits into a number
|
|
;; 0-th digit is right-most digit in number,
|
|
;; N-th digit is left-most digit in number
|
|
(define (convert guesses:vec)
|
|
(local ((define (convert digits)
|
|
(cond
|
|
((empty? digits) 0)
|
|
(else (+ (first digits) (* (convert (rest digits)) 10))))))
|
|
(convert (vector->list guesses:vec))))
|
|
|
|
;; guess-with-gui : (num num -> num) -> void
|
|
;; effect: init target, init frame, set the check-guess function and show the frame
|
|
(define (guess-with-gui/proc cg)
|
|
(check-proc 'guess-with-gui cg 2 'first "two arguments")
|
|
(init-game 5 convert cg))
|
|
|
|
;; guess-with-gui-3 : (digit digit digit num -> num) -> void
|
|
;; effect: init target, init frame, set the check-guess function and show the frame
|
|
(define (guess-with-gui-3/proc cg)
|
|
(check-proc 'guess-with-gui-3 cg (+ 3 1) 'first "four arguments")
|
|
(init-game 3 vector->list
|
|
(lambda (lod target) (apply cg (append lod (list target))))))
|
|
|
|
;; guess-with-gui-list : num ((listof digit) num -> num) -> void
|
|
;; effect: init target, init frame, set the check-guess function and show the frame
|
|
(define (guess-with-gui-list/proc n cg)
|
|
(check-arg 'guess-with-gui-list
|
|
(and (number? n) (integer? n) (>= n 1)) "positive integer" '1st n)
|
|
(check-proc 'guess-with-gui-list cg 2 'first "two arguments")
|
|
(unless (<= (expt 10 n) 2147483647)
|
|
(error 'guess-with-gui-list "the given number of digits (~a) is too large" n))
|
|
(init-game n vector->list cg))
|
|
|