np/scheme-for-kids
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Indent

Browse Source
This commit is contained in:
Nikolay Puzanov 2014-04-18 10:40:19 +04:00
parent 888f8aef0f
commit 22e44c9663
1 changed files with 36 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

72
kot-kit.scm
View File

@ -1,5 +1,5 @@
(import (rnrs io ports (6))) ;; Guile (import (rnrs io ports (6))) ;; Guile
;(require rnrs/io/ports-6) ;; Racket ;;(require rnrs/io/ports-6) ;; Racket
(setlocale LC_ALL "") ;; Guile (setlocale LC_ALL "") ;; Guile
@ -7,7 +7,7 @@
(for-each (lambda (x) (display x)) params) (for-each (lambda (x) (display x)) params)
(newline)) (newline))
;; Helper functions ;; Helper
(define (answer . params) (define (answer . params)
(for-each (lambda (x) (display x)) params) (for-each (lambda (x) (display x)) params)
(flush-output-port (current-output-port)) (flush-output-port (current-output-port))
@ -16,57 +16,57 @@
(define (yes? . params) (define (yes? . params)
(let ((ans (apply answer (append params '("? "))))) (let ((ans (apply answer (append params '("? ")))))
(if (= (string-length ans) 0) (if (= (string-length ans) 0)
#f #f
(or (or
(char-ci=? (string-ref ans 0) #\y) (char-ci=? (string-ref ans 0) #\y)
(char-ci=? (string-ref ans 0) #\д))))) (char-ci=? (string-ref ans 0) #\д)))))
;; Copy tree ;; Copy tree
(define (copy-pet-tree pet-tree) (define (copy-pet-tree pet-tree)
(if (null? pet-tree) (if (null? pet-tree)
'() '()
(list (car pet-tree) (list (car pet-tree)
(cadr pet-tree) (cadr pet-tree)
(copy-pet-tree (caddr pet-tree)) (copy-pet-tree (caddr pet-tree))
(copy-pet-tree (cadddr pet-tree))))) (copy-pet-tree (cadddr pet-tree)))))
;; Main function ;; Main function
(define (game-round pet-tree top-pet-name) (define (game-round pet-tree top-pet-name)
(let walk-pet-tree ((pet-tree pet-tree) (let walk-pet-tree ((pet-tree pet-tree)
(y-pet (list top-pet-name))) (y-pet (list top-pet-name)))
(if (null? pet-tree) (if (null? pet-tree)
(if (yes? "Это " (car y-pet)) (if (yes? "Это " (car y-pet))
(begin (begin
(println "Ура, я угадал!") (println "Ура, я угадал!")
'()) '())
(let* ((name (answer "Сдаюсь! Кто это? ")) (let* ((name (answer "Сдаюсь! Кто это? "))
(feature (answer "Чем " name " отличается от " (car y-pet) "? "))) (feature (answer "Чем " name " отличается от " (car y-pet) "? ")))
(list name feature '() '()))) ;; return new pet (list name feature '() '()))) ;; return new pet
(append (append
(list (car pet-tree) (list (car pet-tree)
(cadr pet-tree)) (cadr pet-tree))
(if (yes? (cadr pet-tree)) (if (yes? (cadr pet-tree))
(list (walk-pet-tree (caddr pet-tree) pet-tree) (list (walk-pet-tree (caddr pet-tree) pet-tree)
(copy-pet-tree (cadddr pet-tree))) (copy-pet-tree (cadddr pet-tree)))
(list (copy-pet-tree (caddr pet-tree)) (list (copy-pet-tree (caddr pet-tree))
(walk-pet-tree (cadddr pet-tree) y-pet))))))) (walk-pet-tree (cadddr pet-tree) y-pet)))))))
(define TREE-FILE-NAME "data.sexp") (define TREE-FILE-NAME "data.sexp")
;; Main LOOP ;; Main LOOP
(let loop ((pet-tree (let loop ((pet-tree
(if (file-exists? TREE-FILE-NAME) (if (file-exists? TREE-FILE-NAME)
(call-with-input-file TREE-FILE-NAME read) (call-with-input-file TREE-FILE-NAME read)
'()))) '())))
(let ((tree (game-round pet-tree "Кот"))) (let ((tree (game-round pet-tree "Кот")))
(newline) (newline)
(if (yes? "Играем еще") (if (yes? "Играем еще")
(loop tree) (loop tree)
(begin (begin
;; Racket ;; Racket
; (if (file-exists? TREE-FILE-NAME) (delete-file TREE-FILE-NAME) #f) ;; (if (file-exists? TREE-FILE-NAME) (delete-file TREE-FILE-NAME) #f)
(call-with-output-file TREE-FILE-NAME (lambda (p) (write tree p))) (call-with-output-file TREE-FILE-NAME (lambda (p) (write tree p)))
)))) ))))
; vim: set ts=2 sts=2 sw=2 expandtab: ;; vim: set ts=2 sts=2 sw=2 expandtab: