-
-
Save tautologico/d29f6be3e0164bc9a765b308e5991768 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| #lang racket/gui | |
| #| | |
| TODO: | |
| 1. Allow random numbers over any integer range (as opposed to the contract attached to random. | |
| 2. Possibly refactor everything into the guess-frame%. | |
| |# | |
| (define min-value (make-parameter 1)) | |
| (define max-value (make-parameter 100)) | |
| (define guess-frame% | |
| (class frame% | |
| (super-new) | |
| (init-field on-traverse-char-callback) | |
| (define/override (on-traverse-char event) | |
| (on-traverse-char-callback event)))) | |
| (define secret #f) | |
| (define last-guess #f) | |
| (define won? #f) | |
| (define (new-game-cb control event) | |
| (set! secret (random (min-value) (add1 (max-value)))) | |
| (set! last-guess #f) | |
| (set! won? #f) | |
| (send slider set-value (quotient (+ (min-value) (max-value)) 2)) | |
| (send guess-button enable #t) | |
| (send slider enable #t) | |
| (send msg set-label "Ok. I've chosen a number. Make a guess.")) | |
| (define (guess-cb control event) | |
| (when won? | |
| (error "Should not be able to guess when game is won")) | |
| (define n (send slider get-value)) | |
| (send msg set-label | |
| (cond | |
| [(= n secret) | |
| (send slider enable #f) | |
| (send guess-button enable #f) | |
| (set! won? #t) | |
| "Congratulations, you won!"] | |
| [(or (not last-guess) (= last-guess n)) | |
| (format "Nope, it's not ~a. Try again." n)] | |
| [(< (abs (- n secret)) (abs (- last-guess secret))) | |
| (format "~a is warmer!" n)] | |
| [else | |
| (format "~a is colder!" n)])) | |
| (set! last-guess n)) | |
| (define (update-slider proc) | |
| (send slider set-value | |
| (min (max-value) | |
| (max (min-value) | |
| (proc (send slider get-value)))))) | |
| (define f | |
| (new guess-frame% | |
| [label "Guess a Number"] | |
| [width 300] | |
| [height 100] | |
| [style '(no-resize-border)] | |
| [on-traverse-char-callback | |
| (λ (event) | |
| (match (send event get-key-code) | |
| ['left (update-slider sub1) #t] | |
| ['right (update-slider add1) #t] | |
| ['up (update-slider (curry + 10)) #t] | |
| ['down (update-slider (curryr - 10)) #t] | |
| [#\return (and (send guess-button is-enabled?) | |
| (guess-cb #f #f)) | |
| #t] | |
| [_ #f]))])) | |
| (define p | |
| (new vertical-panel% | |
| [parent f] | |
| [stretchable-height #f] | |
| [alignment '(center top)] | |
| [horiz-margin 6] | |
| [vert-margin 6])) | |
| (define msg | |
| (new message% | |
| [label "text"] | |
| [parent p] | |
| [stretchable-width #t])) | |
| (define slider | |
| (new slider% | |
| [parent p] | |
| [min-value (min-value)] | |
| [max-value (max-value)] | |
| [label #f])) | |
| (define button-pane | |
| (new horizontal-panel% | |
| [parent p] | |
| [alignment '(center top)])) | |
| (define new-game-button | |
| (new button% | |
| [parent button-pane] | |
| [label "&New Game"] | |
| [callback new-game-cb])) | |
| (define guess-button | |
| (new button% | |
| [parent button-pane] | |
| [label "&Guess"] | |
| [callback guess-cb])) | |
| (define (run) | |
| (random-seed (current-seconds)) | |
| (new-game-cb #f #f) | |
| (send f show #t)) | |
| (module+ main | |
| (run)) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment