(module io (display-newline display-lines show adventure-prompt prompt prompt-default prompt-yn) (import scheme) (import chicken.base) (import srfi-1) (import srfi-13) (import fmt) (import fmt-color) (import breadline) (import ncurses) (import util) (import comparse) (import parse) (define display-newline (compose (just newline) display)) (define (display-lines ln) (perhaps (curry map display-newline) ln)) (define (show str) (fmt #t (dsp (wrap-lines str)))) (define (prompt str) (newline) (let ((result (readline str))) (if (equal? "" result) (prompt str) (begin (add-history! result) result)))) (define (prompt-yn str) (newline) (let ((result (string-downcase (readline str)))) (cond ((equal? "yes" result) #t) ((equal? "no" result) #f) (else (begin (newline) (display "Please answer yes or no.") (prompt-yn str)))))) (define (prompt-default str default) (map stuff-char (string->list default)) (let loop () (let ((result (readline str))) (if (equal? "" result) (loop) result)))) (define +articles-prepositions+ '(a an the into on to at as)) (define (adventure-prompt) (let ((result (parse-line (prompt "> ")))) (if result (let ((grug-result (filter (compose not (cut member <> +articles-prepositions+)) result))) (if (not (null? grug-result)) grug-result (begin (display "I didn't quite understand that.") (adventure-prompt)))) (begin (display "I didn't quite understand that.") (adventure-prompt)))))) ; (define parse-formatter ; (recursive-parser (one-or-more (any-of (followed-by-consuming (char-seq "") (lift fmt-bold parser)) ; (is-not #\<))))))