123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101 |
- (define-module (user-input-output)
- #:use-module (ice-9 textual-ports)
- #:use-module (ice-9 optargs)
- #:use-module (srfi srfi-1)
- #:export (read-line
- write-string
- remove-whitespace-chars
- ask-user
- ask-user-for-character
- ask-user-for-number
- ask-user-for-integer-number
- ask-user-for-yes-no-decision))
- ;; Using the recommended Textual I/O described in:
- ;; https://www.gnu.org/software/guile/manual/html_node/Textual-I_002fO.html#Textual-I_002fO
- (define (read-line)
- (get-line (current-input-port)))
- (define (write-string string)
- (define port (current-output-port))
- (put-string port string))
- (define (remove-whitespace-chars string)
- (string-delete (lambda (char)
- (memq char '(#\newline #\tab #\return #\space)))
- string))
- (define* (ask-user question pred
- #:key
- (input-cleanup-proc remove-whitespace-chars)
- (possible-answers #f)
- (q-a-separator ": ")
- (invalid-input-message "Invalid input.\n"))
- (define (write-question question possible-answers q-a-separator)
- (write-string question)
- (if possible-answers
- (write-string (string-append " " "(" (string-join possible-answers "/") ")"))
- (write-string ""))
- (write-string q-a-separator))
- (write-question question possible-answers q-a-separator)
- (let* ([input (read-line)]
- [cleaned-input (input-cleanup-proc input)])
- (cond [(pred cleaned-input)
- (cond [possible-answers
- (cond [(member cleaned-input possible-answers) cleaned-input]
- [else
- (write-string invalid-input-message)
- (ask-user question
- pred
- #:input-cleanup-proc input-cleanup-proc
- #:possible-answers possible-answers
- #:q-a-separator q-a-separator
- #:invalid-input-message invalid-input-message)])]
- [else cleaned-input])]
- [else (write-string invalid-input-message)
- (ask-user question
- pred
- #:input-cleanup-proc input-cleanup-proc
- #:possible-answers possible-answers
- #:q-a-separator q-a-separator
- #:invalid-input-message invalid-input-message)])))
- (define* (ask-user-for-character question char-pred
- #:key
- (invalid-input-message "Invalid input. Enter a character.\n"))
- (ask-user question
- (λ (input)
- (and (= (string-length input) 1)
- (char-pred (car (string->list input)))))
- #:invalid-input-message invalid-input-message))
- (define (ask-user-for-number question number-pred)
- (string->number
- (ask-user question
- (lambda (input)
- (and (string->number input)
- (number-pred (string->number input)))))))
- (define (ask-user-for-integer-number question number-pred)
- (ask-user-for-number question (λ (num) (and (number-pred num)
- (integer? num)))))
- (define (ask-user-for-yes-no-decision question positive-answers negative-answers)
- (let ([user-input
- (ask-user question
- (λ (input)
- (member input (lset-union string=? positive-answers negative-answers)))
- #:possible-answers (reverse (lset-union string=?
- positive-answers
- negative-answers)))])
- (member user-input positive-answers)))
|