The Hangman game in Guile Scheme (lisp)

hangman.scm

#!/usr/bin/env guile -s
!#

(use-modules
  (srfi srfi-1)
  (ice-9 rdelim))

(define words-path "words.txt")

(define random-word-from-file
  (lambda (file)
    (get-random-line (get-lines-from-file file))))

(set! *random-state* (random-state-from-platform))

(define (get-lines-from-file filename)
  (let ((file-handler (open-input-file filename)))
    (let read-loop ((lines (list)))
      (let ((line (read-line file-handler)))
        (if (eof-object? line)
          (reverse lines)
          (read-loop (cons line lines)))))))

(define (get-random-line lines)
    (list-ref lines (random (length lines))))

(define new-game-state
  (lambda (word-to-guess guesses)
    (list word-to-guess guesses)))

(define word-to-guess
  (lambda (game-state)
    (car game-state)))

(define guesses
  (lambda (game-state)
    (car (cdr game-state))))

(define hangman-images
  (list
    (list "   " " O " " O " " O " " O " "_O " "_O_")
    (list "   " "   " " | " " | " " | " " | " " | ")
    (list "   " "   " "   " "/  " "/ \\" "/ \\" "/ \\")))

(define full-hangman-image
  (lambda (index)
    (append
      (list
        "========="
        "|    |")
      (map
        (lambda (line) (string-append "|   " line))
        (map (lambda (list) (list-ref list index)) hangman-images)))))

(define max-wrong-guesses
  (- (length (car hangman-images)) 1))

(define number-of-wrong-guesses
  (lambda (game-state)
    (length
      (filter
        (lambda (c) (not (member c (string->list (word-to-guess game-state)))))
        (guesses game-state)))))

(define is-guessed?
  (lambda (game-state)
    (every
      (lambda (c) (member c (guesses game-state)))
      (string->list (word-to-guess game-state)))))

(define is-last-guess?
  (lambda (game-state)
    (equal? (number-of-wrong-guesses game-state) max-wrong-guesses)))

(define game-status
  (lambda (game-state)
    (cond
      ((is-guessed? game-state) 'game-won)
      ((is-last-guess? game-state) 'game-lost)
      (else 'guessing))))

(define get-a-char
  (lambda ()
    (let ((line (string->list (read-line))))
      (cond
        ((null? line) (get-a-char))
        (else (car line))))))

(define get-a-new-char
  (lambda (game-state)
    (begin
      (display "Next char to guess: ")
      (let ((char (get-a-char)))
        (cond
          ((member char (guesses game-state))
           (begin
             (display "Character already used in guesses.\n")
             (get-a-new-char game-state)))
          (else char))))))

(define blank-or-char
  (lambda (word-to-guess guesses)
    (list->string
      (map
        (lambda (c) (cond ((member c guesses) c) (else #\_)))
        (string->list word-to-guess)))))

(define display-state
  (lambda (game-state)
    (let ((game-status (game-status game-state))
          (word-to-guess (word-to-guess game-state))
          (guesses (guesses game-state)))
      (display
        (reduce
          (lambda (line1 line2) (string-append line2 "\n" line1))
          ""
          (append
            (full-hangman-image (number-of-wrong-guesses game-state))
            (cond
              ((equal? game-status 'guessing)
               (list
                 (string-append "Word to guess: " (blank-or-char word-to-guess guesses))
                 ""
                 (string-append "Guesses: " (list->string guesses) "\n")))
              ((equal? game-status 'game-won)
               (list
                 "CONGRATULATIONS!"
                 (string-append "You correctly guessed the word " word-to-guess)
                 (string-append "in " (number->string (length guesses)) " tries\n")))
              (else
                (list
                  "YOU FAILED!"
                  (string-append "You failed to guess the word " word-to-guess "\n"))))))))))

(define game-loop
  (lambda (game-state)
    (begin
      (display-state game-state)
      (cond
        ((equal? (game-status game-state) 'guessing)
         (game-loop
           (new-game-state
             (word-to-guess game-state)
             (cons (get-a-new-char game-state) (guesses game-state)))))))))

(define new-game
  (lambda ()
    (new-game-state (random-word-from-file words-path) (list))))

(define main
  (lambda ()
    (begin
      (game-loop (new-game))
      (display "Play again? (Y/n): ")
      (cond
        ((equal? (read-line) "n") (display "Quitting...\n"))
        (else (main))))))

(main)