Zvire.el
zvire.el je program pro demonstraci:
- učících se programů
- implemantace struktury binárního rozhodovacího stromu
- programování v lispu, konkrétně v jeho klonu elisp, použité v editoru emacs
Ilustrace toho, jak se program vyvíjel od jednoduchého ke komplikovanějšímu:
- Zvire-0.01.el 1997-02-16
- Zvire-0.02.el 1997-02-16
- Zvire-0.03.el 1997-02-16
- Zvire-0.04.el 1997-02-16
- Zvire-0.05.el 1997-02-17
; Zvire
; =====
; Copyleft Kychot 1997
(setq zverinec1 '("chlupaté" ("domácí" "kočka" . "tygr") . "ryba"))
(setq zverinec2 '
("chlupaté" ("domácí" ("věrné" "pes" "víc chlupaté" "ovečka" "rohaté" ("více dojivé" "kravička" . "koza") . "kočka") "s velkýma ušima" "medvěd" . "tygr") "slizské" ("dlouhé" "had" "červené" "beruška" . "žába") "pernaté" "slepice" . "ryba")
)
(setq zver-file "zverinec")
(setq minibuf 't) ; Bavime se pres minibuffer?
(defun zvire ()
"Hra na hadani zvirat."
(interactive)
(setq minibuf (ano-ne "Budeme se bavit přes minibuffer?"))
(let ((zver-file "zverinec") (zver-buffer))
(switch-to-buffer "zvire")
(if (file-readable-p zver-file)
(progn
(setq zver-buffer (find-file-noselect zver-file))
(save-excursion
(set-buffer zver-buffer)
(goto-char (point-min)))
(setq zverinec (read zver-buffer)))
(progn
(setq zver-buffer (find-file-noselect zver-file))
(setq zverinec '("chlupaté" "kočka" . "ryba"))))
(while (and (ano-ne "Myslíš si nějaké zvíře? ") (hadej zverinec)))
(if (ano-ne
"Tak si do příště nejaké vymysli. Mám uložit zvířata do zvěřince? ")
(save-excursion
(print zverinec zver-buffer)
(set-buffer zver-buffer)
(save-buffer)))
; (kill-buffer zver-buffer)))
(defun hadej (zvirata)
"Hada podle seznamu zvirata."
(let ((vlastnost (car zvirata))
(takovi-onaci (cdr zvirata))
(prvni-druha)
(vybrany)
(nove-zvire)
(nova-vlastnost)
)
(setq prvni-druha (zeptej-se vlastnost))
(setq vybrany (if prvni-druha (car takovi-onaci)(cdr takovi-onaci)))
(if (consp vybrany)
(hadej vybrany) ; rekurse
(if (odpovez vybrany) ; konec rekurse - pokrac.?
(ano-ne "Hurá, uhádnul jsem. Budeme hádat další zvíře? ")
(progn ; nove zvire do seznamu
(setq nove-zvire (read-string
"Jiné takové zvíře neznám. Jak se jmenuje? "))
(setq nova-vlastnost (read-string (format
"A jaké je %s zvíře na rozdíl od zvířete zvaného %s? "
nove-zvire vybrany)))
(if (ano-ne (format
"Platí, že %s je zvíře %s a %s není zvíře %s? "
nove-zvire nova-vlastnost vybrany nova-vlastnost))
(if prvni-druha
(setcar takovi-onaci
(cons nova-vlastnost (cons nove-zvire vybrany)))
(setcdr takovi-onaci
(cons nova-vlastnost (cons nove-zvire vybrany)))
) )
(ano-ne "Děkuji za poučení. Mám zase hádat? ")
) ) ) ) )
; (hadej zverinec1)
; (zeptej-se 'šedivé)
(defun zeptej-se (vlastnost)
"Zepta se na vlastnost zvirete."
(ano-ne (format "Je to zvíře %s? " vlastnost)))
; (odpovez 'myš)
(defun odpovez (zvire)
"Odpovi uhadnute zvire."
(ano-ne (format "Je to %s! Že mám pravdu? " zvire)))
(defun ano-ne (otazka)
"Zepta se a chce odpoved a/n."
(let ((odpoved))
(insert-string otazka)
(catch 'loop
(while 't
(setq odpoved (read-char))
(if (eq odpoved ?a) (progn (_output " ano\n") (throw 'loop 't))
(if (eq odpoved ?A) (progn (_output " Ano\n") (throw 'loop 't))
(if (eq odpoved ?y) (progn (_output " yes\n") (throw 'loop 't))
(if (eq odpoved ?Y) (progn (_output " Yes\n") (throw 'loop 't))
(if (eq odpoved ?j) (progn (_output " jo\n") (throw 'loop 't))
(if (eq odpoved ?J) (progn (_output " Jo\n") (throw 'loop 't))
(if (eq odpoved ?n) (progn (_output " ne\n") (throw 'loop nil))
(if (eq odpoved ?N) (progn (_output " Ne\n") (throw 'loop nil))
))))))))))))
; (ano-ne "Zkouška?")Zkouška? Yes
(defun _output (mess)
"Vystup do minibufferu nebo do bufferu."
(interactive)
(if minibuf
(message mess)
(insert-string mess)))
(defun _input-string(mess)
"Vstup stringu pres minibuffer nebo pres buffer."
(interactive)
(if minibuf
(read-string mess)
(let ((beg))
(insert-string (concat mess " "))
(set beg (point))