Victor Fors пре 3 година
родитељ
комит
6bd256f87a
1 измењених фајлова са 17 додато и 8 уклоњено
  1. +17
    -8
      kekkonen.scm

+ 17
- 8
kekkonen.scm Прегледај датотеку

@@ -7,6 +7,7 @@
(import fmt) (import fmt)
(import ansi-escape-sequences) (import ansi-escape-sequences)
(import (chicken file)) (import (chicken file))
(import breadline)


(define (lift fn parser) (define (lift fn parser)
(bind parser (compose result fn))) (bind parser (compose result fn)))
@@ -84,30 +85,38 @@


(define (prompt str) (define (prompt str)
(newline) (newline)
(display str)
(let ((result (read-line)))
(let ((result (readline str)))
(if (equal? "" result) (if (equal? "" result)
(prompt str) (prompt str)
result)))
(begin
(add-history! result)
result))))


(define (prompt-yn str) (define (prompt-yn str)
(newline) (newline)
(display str)
(let ((result (string-downcase (read-line))))
(let ((result (string-downcase (readline str))))
(cond ((equal? "yes" result) #t) (cond ((equal? "yes" result) #t)
((equal? "no" result) #t)
((equal? "no" result) #f)
(else (begin (else (begin
(newline) (newline)
(display "Please answer yes or no.") (display "Please answer yes or no.")
(prompt-yn str)))))) (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+ (define +articles-prepositions+
'(a an the into on to at as)) '(a an the into on to at as))


(define (adventure-prompt) (define (adventure-prompt)
(let ((result (parse (completely-parse parse-statement) (prompt "> ")))) (let ((result (parse (completely-parse parse-statement) (prompt "> "))))
(if result (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)) (if (not (null? grug-result))
grug-result grug-result
(begin (display "I didn't quite understand that.") (begin (display "I didn't quite understand that.")
@@ -300,7 +309,7 @@
(print-room-description (get-container 'you)))))))) (print-room-description (get-container 'you))))))))


(define (do-command-save) (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? ")) (if (or (not (file-exists? save-name)) (prompt-yn "That file already exists. Overwrite? "))
(begin (begin
(show "Saving database, please wait...") (show "Saving database, please wait...")


Loading…
Откажи
Сачувај