kekkonen/io.scm

(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 "<b>") (lift fmt-bold parser))
; 					   (is-not #\<))))))