Přeskočit na obsah

Zvire-0.04.el

Z Wikiverzity

Demonstrační program Zvire-0.04.el, tj. verse 0.04. Poslední verze viz Zvire.el


; Zvire
; =====
; Copyleft Kychot 1997
;
; Verse 0.04 - zpruhledneni

(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")

(defun zvire ()
    "Hra na hádání zvířat."
    (interactive)
    (let ((zver-file "zverinec") (zver-buffer))
	(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 (y-or-n-p "Myslíš si nějaké zvíře? ") (hadej zverinec)))
	(if (y-or-n-p 
	"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.?
		    (y-or-n-p "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 (y-or-n-p (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)))
		    )	)
		    (y-or-n-p "Děkuji za poučení. Mám zase hádat? ")
)   )   )   )   )
; (hadej zverinec1)

; (zeptej-se 'šedivé)
(defun zeptej-se (vlastnost)
	"Zepta se na vlastnost zvirete."
	(y-or-n-p (format "Je to zvíře %s? " vlastnost)))

; (odpovez 'myš)
(defun odpovez (zvire)
	"Odpovi uhadnute zvire."
	(y-or-n-p (format "Je to %s! Že mám pravdu? " zvire)))

(defun a-or-n-p (otazka)
	"Jako y-or-n-p ale cesky a/n"
	(let ((odpoved))
	(setq odpoved (read-string (format "%s(a/n)" otazka)))
	(if (eq odpoved 'a) 't
		(if (eq odpoved 'n) nil
			(a-or-n-p otazka)))))
; (a-or-n-p 'zkouška)