guess.rkt

#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 (run)
  (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]))

  (random-seed (current-seconds))

  (new-game-cb #f #f)
  (send f show #t))

(module+ main
  (run))