diff options
| -rw-r--r-- | kelime.lisp | 21 | ||||
| -rw-r--r-- | okur.lisp | 24 | ||||
| -rw-r--r-- | paket.lisp | 3 | ||||
| -rw-r--r-- | soru.lisp | 53 |
4 files changed, 68 insertions, 33 deletions
diff --git a/kelime.lisp b/kelime.lisp index ca830f5..09610cf 100644 --- a/kelime.lisp +++ b/kelime.lisp @@ -4,8 +4,9 @@ ((kanji :accessor kanji :initarg :kanji :initform nil) (kana :accessor kana :initarg :kana :initform nil) (anlam :accessor anlam :initarg :anlam :initform nil) - (grup :accessor grup :initarg :grup :initform nil) - (altgrup :accessor altgrup :initarg :altgrup :initform nil))) + (tür :accessor tür :initarg :tür :initform nil) + (alttür :accessor alttür :initarg :alttür :initform nil) + (sıra :accessor sıra :initarg :sıra :initform nil))) (defmethod print-object ((kelime kelime) stream) (print-unreadable-object (kelime stream :type t) @@ -58,6 +59,22 @@ (if index (values (aref kelimeler index) index)))) +(defun kelimeleri-kar (kelimeler) + (let ((boy (length kelimeler))) + (loop :repeat (* 10 boy) + :do (rotatef (aref kelimeler (random boy)) + (aref kelimeler (random boy)))))) + +(defun kelimeleri-sırala (kelimeler) + (let ((boy (length kelimeler)) + (i 0)) + (loop :while (< i boy) + :do (let ((kelime (aref kelimeler i))) + (if (= i (sıra kelime)) + (incf i) + (rotatef (aref kelimeler i) + (aref kelimeler (sıra kelime)))))))) + ;; (defun son-n-kelime-tut (n) ;; (setf son-kelimeler ;; (make-array n :initial-element (make-instance 'kelime) @@ -96,8 +96,8 @@ (boşluk-geç okur) (anlam-oku okur))))) -(defmethod kelime-oku ((okur okur)) - (let (kanji kana anlam grup altgrup) +(defmethod kelime-oku ((okur okur) sıra) + (let (kanji kana anlam tür alttür) (setf kanji (kanji-oku okur)) (boşluk-geç okur) (setf kana (kana-oku okur)) @@ -107,28 +107,30 @@ ;; (yeni-satıra-geç okur) (kar-oku okur) (boşluk-geç okur) - (setf grup (sonraki-öbek okur '(#\Newline #\Space #\; #\,))) - (cond ((or (string= grup "fiil") - (string= grup "sıfat")) + (setf tür (sonraki-öbek okur '(#\Newline #\Space #\; #\,))) + (cond ((or (string= tür "fiil") + (string= tür "sıfat")) (boşluk-geç okur) - (setf altgrup (sonraki-öbek okur '(#\Newline #\Space #\;)))) + (setf alttür (sonraki-öbek okur '(#\Newline #\Space #\;)))) ((char= #\, (kar-bak okur)) (kar-oku okur) (boşluk-geç okur) - (push (sonraki-öbek okur '(#\Newline #\Space #\;)) grup)))) + (setf tür (list tür (sonraki-öbek okur '(#\Newline #\Space #\;))))))) (make-instance 'kelime :kanji kanji :kana kana :anlam anlam - :grup grup :altgrup altgrup))) + :tür tür :alttür alttür :sıra sıra))) (defmethod işle ((okur okur)) (unless (eq :baş (durum okur)) (error "Okur zaten işlenmiş")) - (loop :until (metin-bitti? okur) + (loop :with sıra := 0 + :until (metin-bitti? okur) :do (case (kar-bak okur) (#\; (yeni-satıra-geç okur)) (#\Newline (yeni-satıra-geç okur)) (#\Space (boşluk-geç okur)) - (otherwise (vector-push-extend (kelime-oku okur) - (kelimeler okur))))) + (otherwise (vector-push-extend (kelime-oku okur sıra) + (kelimeler okur)) + (incf sıra)))) (kelimeler okur)) (defmacro okurla ((isim dosya-ismi) &body beden) @@ -1,2 +1,3 @@ (defpackage :japonca - (:use :common-lisp))
\ No newline at end of file + (:use :common-lisp) + (:export alıştırma kelime-bul)) @@ -4,8 +4,7 @@ (defparameter *kelimeler* nil) (defparameter *kelimeler-dosyası* - (format nil "/home/~a/projects/japonca/kelime/kelimeler.txt" - (uiop:hostname))) + (asdf:system-relative-pathname :japonca "kelime/kelimeler.txt")) (defun kelimeleri-yükle (&optional (dosya *kelimeler-dosyası*)) (setf *kelimeler* @@ -26,7 +25,7 @@ (when *soru-sayısı* (format t "~a. " *soru-sayısı*))) -(defmethod kelime-soru ((kelime kelime) (tip (eql :okunuş)) ) +(defmethod kelime-soru ((kelime kelime) (tip (eql :okunuş))) (block soru (let (cevap sonuç) (format t "~a nasıl okunur ? " (kanji kelime)) @@ -40,25 +39,41 @@ (defgeneric alıştırma (tip &key &allow-other-keys)) -(defmethod alıştırma :before ((tip (eql :okunuş)) &key (baş 0) son &allow-other-keys) - (when (null *kelimeler*) - (kelimeleri-yükle)) - (format t "Tanımlı kelimeler: ~d~%" (fill-pointer *kelimeler*)) +(defmethod alıştırma :before ((tip (eql :okunuş)) &key (baş 0) son sırayla (kelimeler *kelimeler*) &allow-other-keys) + (when (null kelimeler) + (setf kelimeler (kelimeleri-yükle))) + (format t "Tanımlı kelimeler: ~d~%" (fill-pointer kelimeler)) (when (not son) - (setf son (length *kelimeler*))) - (format t "Aralık: ~d-~d, ~d kelime~%" baş (- son 1) (- son baş))) + (setf son (length kelimeler))) + (when (not sırayla) + (format t "Aralık: ~d-~d, ~d kelime~%" baş (- son 1) (- son baş)))) -(defmethod alıştırma ((tip (eql :okunuş)) &key (baş 0) son &allow-other-keys) +(defmethod alıştırma ((tip (eql :okunuş)) &key (baş 0) son sırayla (kelimeler *kelimeler*) &allow-other-keys) (let ((yanlış 0) (doğru 0)) - (loop :for *soru-sayısı* :from 1 - :for cevap := (kelime-soru (rastgele-kelime *kelimeler* :test #'kanji - :baş baş :son son) - :okunuş) - :do (cond ((eq :çık cevap) - (format t "~d/~d~%" doğru (+ doğru yanlış)) - (loop-finish)) - ((not cevap) (incf yanlış)) - (t (incf doğru)))))) + (if (not sırayla) + (loop :for *soru-sayısı* :from 1 + :for cevap := (kelime-soru (rastgele-kelime kelimeler :test #'kanji + :baş baş :son son) + :okunuş) + :do (cond ((eq :çık cevap) + (format t "~d/~d~%" doğru (+ doğru yanlış)) + (loop-finish)) + ((not cevap) (incf yanlış)) + (t (incf doğru)))) + (progn (kelimeleri-kar kelimeler) + (loop :with *soru-sayısı* := 1 + :for i :from 0 :below (length kelimeler) + :for cevap := (if (null (kanji (aref kelimeler i))) + :geç + (kelime-soru (aref kelimeler i) :okunuş)) + :do (cond ((eq :çık cevap) + (format t "~d/~d~%" doğru (+ doğru yanlış)) + (loop-finish)) + ((not cevap) (incf yanlış)) + (t (incf doğru))) + (unless (eq :geç cevap) + (incf *soru-sayısı*))) + (kelimeleri-sırala kelimeler))))) ;; (defmacro soru-tanım (args &body beden) ;; `(block soru |