hangman.rkt

#lang racket/base

(require racket/class
         racket/contract
         racket/list
         racket/string)

(provide (all-defined-out))

(define/contract steps exact-positive-integer? 7)

(define/contract (choice lst)
  ((non-empty-listof any/c) . -> . any/c)
  (car (shuffle lst)))

(define/contract words
  (listof non-empty-string?)
  (call-with-input-file "words.rktd" read))

(define guessing-game%
  (class object%
    (super-new)
    (init-field [word (choice words)]
                [guesses '()])
    (define/public (get-guesses)
      guesses)
    (define/public (get-word)
      word)
    (define/private (get-normalized-word)
      (string-downcase word))
    (define/private (get-normalized-guesses)
      (map (λ (v) (cond
                    [(string? v) (string-downcase v)]
                    [(char? v) (char-downcase v)]
                    [else (raise-type-error 'bad-guess "(or/c string? char?)" v)]))
           guesses))
    (define/public (guess letter-or-word)
      (define match? (cond
                       [(string? letter-or-word)
                        (equal?
                         (string-downcase letter-or-word)
                         (get-normalized-word))]
                       [(char? letter-or-word)
                        (memv (char-downcase letter-or-word)
                              (string->list (get-normalized-word)))]
                       [else (raise-argument-error 'bad-guess
                                                   "(or/c string? char?)"
                                                   letter-or-word)]))
      (set! guesses (append guesses (list letter-or-word)))
      (if (and match? (won?))
          'won
          ;; Flatten match?.
          (and match? #t)))
    (define/public (won?)
      (define char-guesses (filter char? (get-normalized-guesses)))
      (or
       ;; Are all chars in word also in guesses?
       (andmap (λ (c) (and
                       (char? c)
                       (memv (char-downcase c) char-guesses)))
               (string->list (get-normalized-word)))
       ;; Was the word correctly guessed in full?
       (ormap (λ (s) (and
                      (string? s)
                      (equal? s (get-normalized-word))))
              (get-normalized-guesses))))
    (define/public (render)
      (if (won?)
          word
          (list->string
           (map (λ (c)
                  (if (memv c (get-normalized-guesses))
                      c
                      #\_))
                (string->list (get-normalized-word))))))))

(define hangman-game%
  (class guessing-game%
    (super-new)
    (init-field [chances 7])
    (inherit-field guesses)
    (define/public (get-chances)
      chances)
    (define/public (get-chances-left)
      (- chances (length guesses)))
    (define/override (won?)
      (and (super won?)
           (positive? (get-chances-left))))
    (define/public (lost?)
      (not (positive? (get-chances-left))))))