|
|
@@ -7,6 +7,7 @@ |
|
|
|
(import fmt) |
|
|
|
(import ansi-escape-sequences) |
|
|
|
(import (chicken file)) |
|
|
|
(import breadline) |
|
|
|
|
|
|
|
(define (lift fn parser) |
|
|
|
(bind parser (compose result fn))) |
|
|
@@ -84,30 +85,38 @@ |
|
|
|
|
|
|
|
(define (prompt str) |
|
|
|
(newline) |
|
|
|
(display str) |
|
|
|
(let ((result (read-line))) |
|
|
|
(let ((result (readline str))) |
|
|
|
(if (equal? "" result) |
|
|
|
(prompt str) |
|
|
|
result))) |
|
|
|
(begin |
|
|
|
(add-history! result) |
|
|
|
result)))) |
|
|
|
|
|
|
|
(define (prompt-yn str) |
|
|
|
(newline) |
|
|
|
(display str) |
|
|
|
(let ((result (string-downcase (read-line)))) |
|
|
|
(let ((result (string-downcase (readline str)))) |
|
|
|
(cond ((equal? "yes" result) #t) |
|
|
|
((equal? "no" 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 (completely-parse parse-statement) (prompt "> ")))) |
|
|
|
(if result |
|
|
|
(let ((grug-result (filter (lambda (n) (not (member n +articles-prepositions+))) 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.") |
|
|
@@ -300,7 +309,7 @@ |
|
|
|
(print-room-description (get-container 'you)))))))) |
|
|
|
|
|
|
|
(define (do-command-save) |
|
|
|
(let ((save-name (prompt "Enter save name: "))) |
|
|
|
(let ((save-name (prompt-default "Enter save name: " "kekkonen.sav"))) |
|
|
|
(if (or (not (file-exists? save-name)) (prompt-yn "That file already exists. Overwrite? ")) |
|
|
|
(begin |
|
|
|
(show "Saving database, please wait...") |
|
|
|