init

README.txt

@@ -0,0 +1,4 @@
+Kişisel kullanım amacıyla yaptığım için
+herhangi bir arayüz ya da executable build yok.
+Emacs + Slime kullanılmalı.
+Emacsta toggle-input-method fonksiyonu ile Japonca yazabilirsiniz.

japonca.asd

@@ -0,0 +1,13 @@
+(defsystem japonca
+  :author "Emre Akan"
+  ;; :license ""
+  ;; :depends-on ()
+  :description "Japonca bilgisini pekiştirmek amaçlı soru soran program"
+  :components ((:file "paket")
+               (:file "util")
+               ;; (:file "kana")
+               (:file "kelime")
+               (:file "okur")
+               (:file "sayı")
+               ;; (:file "japonca")
+               (:file "soru")))

kelime.lisp

@@ -0,0 +1,72 @@
+(in-package :japonca)
+
+(defclass kelime ()
+  ((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)))
+
+(defmethod print-object ((kelime kelime) stream)
+  (print-unreadable-object (kelime stream :type t)
+    (with-slots (kanji kana anlam) kelime
+      (if (null kanji)
+          (format stream "~a : ~{~a~^, ~}" kana anlam)
+          (format stream "~a ~a : ~{~a~^, ~}" kanji kana anlam)))))
+
+(defun kelime-yap (kanji kana anlam)
+  (make-instance 'kelime :kanji kanji :kana kana :anlam anlam))
+
+(defmethod kanji= ((kelime kelime) kanji)
+  (string= (kanji kelime) kanji))
+
+(defmethod kana= ((kelime kelime) kana)
+  (find kana (kana kelime) :test #'string=))
+
+(defmethod anlam= ((kelime kelime) anlam)
+  (find anlam (anlam kelime) :test #'string=))
+
+(let* ((son-sayısı 5)
+       (son-kelimeler (make-array son-sayısı
+                                  :initial-element (make-instance 'kelime)
+                                  :element-type 'kelime :fill-pointer 0))
+       (i 0))
+  (labels ((tarih-ekle (kelime)
+             (if (= son-sayısı (fill-pointer son-kelimeler))
+                 (setf (aref son-kelimeler i) kelime
+                       i (mod (incf i) son-sayısı))
+                 (vector-push kelime son-kelimeler))))
+    (defun rastgele-kelime (kelimeler &key (test #'identity) (baş 0) son)
+      ;; (declare (type number son))
+      (let* ((len (length kelimeler))
+             (son (if (and (not (null son)) (<= son len))
+                      son
+                      len))
+             (kelime (loop :for kelime := (aref kelimeler (+ baş (random (- son baş))))
+                           :while (or (not (funcall test kelime))
+                                      (find kelime son-kelimeler :test #'eql))
+                           :finally (return kelime))))
+        (tarih-ekle kelime)
+        kelime)))
+  (defun son-rastgele-kelimeler ()
+    son-kelimeler)
+  (defun son-kelimeler-reset ()
+    (setf (fill-pointer son-kelimeler) 0)))
+
+(defun kelime-bul (kelimeler &key kanji)
+  (let ((index (position kanji kelimeler :test #'string-equal :key #'kanji)))
+    (if index
+        (values (aref kelimeler index) index))))
+
+;; (defun son-n-kelime-tut (n)
+;; 	(setf son-kelimeler
+;; 		  (make-array n :initial-element (make-instance 'kelime)
+;; 						:element-type 'kelime :fill-pointer 0)))
+
+;; (defun rastgele-kelime (kelimeler &optional if-fn)
+;;   (let ((len (length kelimeler)))
+;; 	(if if-fn
+;; 		(loop :for kelime = (aref kelimeler (random len))
+;; 			  :until (funcall if-fn kelime)
+;; 			  :finally (return kelime))
+;; 		(aref kelimeler (random len)))))

kelime/kelimeler.txt

@@ -0,0 +1,259 @@
+; learnihongo
+
+行く いく gitmek | fiil 1
+見る みる bakmak,görmek,izlemek | fiil 2
+多い おおい çok | sıfat i
+家 いえ、うち ev | isim
+- これ bu | zamir
+- それ şu | zamir
+私 わたし ben | zamir
+仕事 しごと iş | isim
+- いつ ne zaman | soru
+- する yapmak | fiil 3
+出る でる çıkmak,ayrılmak | fiil 2
+使う つかう kullanmak | fiil 1
+所 ところ yer,mahal | isim
+作る つくる yapmak,oluşturmak | fiil 1
+思う おもう düşünmek | fiil 1
+持つ もつ sahip olmak,taşımak | fiil 1
+買う かう satın almak | fiil 1
+時間 じかん zaman,vakit | isim, zarf
+知る しる bilmek,tanımak | fiil 1
+同じ おなじ aynı | isim, zarf
+今 いま şimdi | zarf
+新しい あたらしい yeni | sıfat i
+成る なる olmak | fiil 1
+- まだ hala,henüz | zarf
+- あと sonra,daha sonra | isim
+聞く きく duymak,sormak | fiil 1
+言う いう söylemek | fiil 1
+少ない すくない az,nadir | sıfat i
+高い たかい yüksek,pahalı | sıfat i
+子供 こども çocuk | isim
+- そう şöyle,öyle | zarf
+- もう zaten,hala,henüz,artık | zarf
+学生 がくせい öğrenci | isim
+熱い あつい sıcak | sıfat i ; (nesne)
+- どうぞ lütfen,buyrun | zarf
+午後 ごご öğleden sonra,PM | zarf
+長い ながい uzun | sıfat i
+本 ほん kitap | isim
+今年 ことし bu yıl | zarf
+- よく sık sık | zarf
+彼女 かのじょ o, sevgili | zamir ; o bayan
+- どう ne,nasıl | soru
+言葉 ことば kelime, söz | isim
+顔 かお yüz,surat | isim
+終わる おわる bitmek, son bulmak | fiil 1
+一つ ひとつ bir | isim
+- あげる vermek | fiil 2
+- こう böyle | zarf
+学校 がっこう okul | isim
+- くれる vermek | fiil 2
+始める はじめる başlamak | fiil 2
+起きる おきる kalkmak, uyanmak | fiil 2
+春 はる ilkbahar | isim, zarf
+午前 ごぜん sabah,öğleden önce,AM | isim, zarf
+別 べつ diğer,farklı,başka | sıfat
+- どこ nere,neresi | soru
+部屋 へや oda | isim
+若い わかい genç | sıfat i
+車 くるま araba | isim
+置く おく koymak,bırakmak | fiil 1
+住む すむ yaşamak | fiil 1
+働く はたらく çalışmak | fiil 1
+難しい むずかしい zor | sıfat i
+先生 せんせい öğretmen,hoca | isim
+立つ たつ ayakta durmak, ayağa kalkmak | fiil 1
+呼ぶ よぶ çağırmak,seslenmek | fiil 1
+大学 だいがく üniversite | isim
+安い やすい ucuz | sıfat i
+- もっと daha,daha fazla | zarf
+帰る かえる eve dönmek | fiil 1
+分る わかる anlamak | fiil 1
+広い ひろい geniş | sıfat i
+数 かず sayı | isim
+近い ちかい yakın | sıfat i
+- そこ şurası,şura | zamir
+走る はしる koşmak | fiil 1
+入れる いれる içine koymak | fiil 2
+教える おしえる öğretmek,anlatmak | fiil 2
+歩く あるく yürümek | fiil 1
+会う あう buluşmak | fiil 1
+畫く かく yazmak | fiil 1
+頭 あたま kafa,baş | isim
+売る うる satmak | fiil 1
+先月 せんげつ geçen ay | zarf
+体 からだ vücut, beden | isim
+直ぐ すぐ hemen | zarf
+飛ぶ とぶ uçmak | fiil 1
+- とても çok | zarf
+誰 だれ kim | soru
+好き すき sevmek, sevilen | sıfat na
+読む よむ okumak | fiil 1
+次 つぎ sonraki | isim, sıfat
+- あなた sen | zamir
+飲む のむ içmek | fiil 1
+古い ふるい eski | sıfat i
+質問 しつもん soru | isim
+今日 きょう bugün | zarf
+友達 ともだち arkadaş | isim
+早い はやい erken | sıfat i
+- どれ hangisi | soru
+美しい うつくしい güzel | sıfat i
+- いつも her zaman | zarf
+足 あし bacak, ayak | isim
+起こす おこす uyandırmak | fiil 1
+見せる みせる göstermek | fiil 2
+娘 むすめ kız evlat | isim
+楽しむ たのしむ eğlenmek, sevinmek | fiil 1
+色 いろ renk | isim
+取る とる almak, tutmak, çıkarmak | fiil 1
+勉強 べんきょう çalışma, öğrenme | isim
+- できる yapılmak, yapabilmek | fiil 2
+短い みじかい kısa | sıfat i
+- みんな herkes | isim
+落る おちる düşmek, sınavda kalmak | fiil 2
+息子 むすこ erkek evlat, oğul | isim
+白い しろい beyaz | sıfat i
+飛行機 ひこうき uçak | isim
+病気 びょうき hastalık | isim, sıfat
+冬 ふゆ kış | isim, zarf
+年 とし、ねん yıl, yaş | isim
+重い おもい ağır | sıfat i
+胸 むね göğüs | isim
+払う はらう ödemek | fiil 1 ; para
+軽い かるい hafif | sıfat i
+見つける みつける bulmak | fiil 2 ; 見付ける?
+忘すれる わすれる unutmak | fiil 2
+酒 さけ içki, alkol | isim
+- どちら hangisi, ne taraf, kim | soru
+姉 あね abla | isim
+覚える おぼえる ezberlemek, hatırlamak | fiil 2
+狭い せまい dar, küçük | sıfat i
+赤い あかい kırmızı | sıfat i
+着る きる giymek | fiil 2
+笑う わらう gülmek | fiil 1
+一番 いちばん en | zarf
+授業 じゅぎょう ders | isim
+週 しゅう hafta | isim
+漢字 かんじ kanji | isim
+自転車 じてんしゃ bisiklet | isim
+電車 でんしゃ tren | isim
+探す さがす aramak | fiil 1
+紙 かみ kağıt | isim
+歌う うたう şarkı söylemek | fiil 1
+遅い おそい geç | sıfat i
+首 くび boyun | isim
+速い はやい hızlı, çabuk | sıfat i
+一緒に いっしょに beraber | zarf
+今月 こんげつ bu ay | zarf
+遊ぶ あそぶ oynamak | fiil 1
+遠く とおく uzak | zarf
+弱い よわい zayıf, güçsüz | sıfat i
+耳 みみ kulak | isim
+座る すわる oturmak | fiil 1
+右 みぎ sağ | isim
+浴びる あびる duş almak, yıkanmak | fiil 2
+肩 かた omuz | isim
+寝る ねる uyumak, uyumaya gitmek | fiil 2
+消す けす söndürmek, kapatmak (elektrik) | fiil 1
+元気 げんき iyi, sağlıklı, enerjik | sıfat na
+全部 ぜんぶ hepsi, tüm | isim, zarf
+去年 きょねん geçen yıl | isim, zarf
+引く ひく çekmek, çıkarmak, çizmek | fiil 1
+図書館 としょかん kütüphane | isim
+上げる あげる yükseltmek, kaldırmak | fiil 2
+緑 みどり yeşil | sıfat na
+腕 うで kol | isim
+- ドア kapı | isim
+女の子 おんなのこ küçük kız çocuk, kız çocuk | isim
+男の子 おとこのこ küçük erkek çocuk, erkek çocuk, oğlan | isim
+私たち わたしたち biz | zamir
+近く ちかく yakın, yakın gelecek | zarf
+遣る やる yapmak, vermek | fiil 1
+国 くに ülke | isim
+- かなり epey, oldukça | zarf
+起こる おこる olmak, meydana gelmek | fiil 1
+秋 あき sonbahar | isim
+送る おくる göndermek | fiil 1
+死ぬ しぬ ölmek | fiil 1
+気持ち きもち hal, hissiyat, keyf | isim
+乗る のる binmek | fiil 1
+- いる var olmak, bulunmak | fiil 2 ; canlılar için
+木 き ağaç | isim
+開ける あける açmak | fiil 2   ; kapı, pencere...
+閉める しめる kapamak | fiil 2 ; ^
+続く つづく devam etmek, sürmek | fiil 1
+医者 いしゃ doktor | isim
+円 えん yen | isim
+- ここ bura, burası | zamir
+待つ まつ beklemek | fiil 1
+低い ひくい alçak | sıfat i ; yükselik olarak, 川の水位が低い (水位、すいい su seviyesi)
+- もらう almak | fiil 1
+食べる たべる yemek yemek | fiil 2
+兄 あに abi | isim
+名前 なまえ isim, ad | isim
+夫 おっと koca, eş | isim
+- すごい harika, epey, süper | sıfat i
+結婚 けっこん evlilik | isim
+親 おや ebeveyn, anne baba | isim
+話す はなす konuşmak | fiil 1
+少し すこし biraz | zarf
+閉じる とじる kapatmak | fiil 2
+時 とき zaman | isim
+米 こめ pirinç | isim
+切る きる kesmek | fiil 1
+楽しい たのしい eğlenceli, keyifli | sıfat i
+服 ふく elbise, kıyafet, giysi | isim
+後ろ うしろ arka | isim
+嬉しい うれしい mutlu | sıfat i
+腰 こし bel | isim
+日曜日 にちようび pazar | zarf
+昼 ひる öğlen, öğle | isim, zarf
+お母さん おかあさん anne | isim
+大学生 だいがくせい üniversite öğrencisi | isim
+終り おわり son, bitiş | isim
+背 せ boy, endam | isim
+手伝う てつだう yardım etmek | fiil 1
+鼻 はな burun | isim
+起きる おきる olmak, uyanmak | fiil 2
+悲しい かなしい üzgün, hüzünlü | sıfat i
+載せる のせる üzerine koymak, arabaya yüklemek | fiil 2
+喋る しゃべる konuşmak | fiil 1
+甘い あまい tatlı | sıfat i ; tat
+- テーブル masa | isim
+食べ物 たべもの yiyecek, gıda | isim
+始まる はじまる başlamak | fiil 1
+- ゲーム oyun | isim
+親切 しんせつ kibar, nazik | sıfat na
+天気 てんき hava | isim
+暑い あつい sıcak | sıfat i ; (hava)
+太い ふとい şişman, kalın | sıfat i
+; 231 furui 95 le aynı ??
+晩 ばん akşam | isim, zarf
+土曜日 どようび cumartesi | zarf
+痛い いたい acı | sıfat i
+お父さん おとうさん baba | isim
+多分 たぶん belki, galiba, muhtemelen | isim, zarf
+
+
+; ******************************
+; ekstra
+一 いち bir
+着物 きもの kimono
+家族 かぞく aile
+嫌い きらい nefret etmek
+映画 えいが film
+明日 あした yarın
+中国 ちゅうごく Çin
+簡単 かんたん kolay
+傘 かさ şemsiye
+間 あいだ arasında
+
+来る きる gelmek
+止まり とまり durmak
+遅れる おくれる geç kalmak
+; sözlük haline bak
+; sözlük : jisho.org
+; quail-jp : /usr/local/share/emacs/29.4/lisp/leim/quail/

okur.lisp

@@ -0,0 +1,158 @@
+;;; **************************************************
+;;;; Kelimeler dosyasındaki tanımlı kelimeleri okuma *
+;;; **************************************************
+(in-package :japonca)
+
+(defclass okur ()
+  ((dosya :accessor dosya :initarg :dosya)
+   (metin :accessor metin)
+   (durum :accessor durum :initform :baş)
+   (i :accessor i :initform 0)
+   (kelimeler :accessor kelimeler
+              :initform (make-array 10 :adjustable t :fill-pointer 0))))
+
+(defmethod metni-yükle ((okur okur))
+  (setf (metin okur)
+        (dosya-metni-oku (dosya okur))))
+
+(defmethod metin-bitti? ((okur okur))
+  (eq :son (durum okur)))
+
+(defmethod ++kar ((okur okur))
+  (incf (i okur))
+  (if (array-in-bounds-p (metin okur) (i okur))
+      (i okur)
+      (setf (durum okur) :son)))
+
+(defmethod kar++ ((okur okur))
+  (let ((i (i okur)))
+    (++kar okur)
+    i))
+
+(defmethod kar-oku ((okur okur))
+  (unless (metin-bitti? okur)
+    (char (metin okur) (kar++ okur))))
+
+(defmethod kar-bak ((okur okur))
+  (char (metin okur) (i okur)))
+
+(defmethod boşluğa-kadar ((okur okur))
+  (loop :until (or (metin-bitti? okur)
+                   (char= #\Space (kar-bak okur)))
+        :do (++kar okur)))
+
+(defmethod boşluk-geç ((okur okur))
+  (loop :until (metin-bitti? okur)
+        :do (let ((kar (kar-bak okur)))
+              (if (char= #\Space kar)
+                  (kar-oku okur)
+                  (return)))))
+
+(defmethod yeni-satıra-geç ((okur okur))
+  (loop :until (metin-bitti? okur)
+        :do (let ((kar (kar-oku okur)))
+              (when (char= #\Newline kar)
+                (return)))))
+;; (setf (durum okur) :yeni-satır)
+
+;; (defparameter +öbek-son-ch+ '(#\Space #\Newline #\; #\, #\、))
+(defmethod sonraki-öbek ((okur okur) son-kar)
+  (let ((baş (i okur)))
+    (loop :until (metin-bitti? okur)
+          :do (let ((kar (kar-bak okur)))
+                (if (find kar son-kar :test #'char=)
+                    (loop-finish)
+                    (++kar okur)))
+          :finally (loop :while (char= #\Space
+                                       (char (metin okur)
+                                             (- (i okur) 1)))
+                         :do (decf (i okur))))
+    (make-array (- (i okur) baş)
+                :element-type 'character
+                :displaced-to (metin okur)
+                :displaced-index-offset baş)))
+
+(defmethod kanji-oku ((okur okur))
+  (let ((öbek (sonraki-öbek okur '(#\Space))))
+    (unless (string= "-" öbek)
+      öbek)))
+
+(defmethod kana-oku ((okur okur))
+  (let ((öbek (sonraki-öbek okur '(#\Space #\、))))
+    (boşluk-geç okur)
+    (cons öbek
+          (when (char= #\、 (kar-bak okur))
+            (kar-oku okur)
+            (boşluk-geç okur)
+            (kana-oku okur)))))
+
+(defmethod anlam-oku ((okur okur))
+  (let ((öbek (sonraki-öbek okur '(#\, #\Newline #\; #\|))))
+    (boşluk-geç okur)
+    (cons öbek
+          (when (and (not (metin-bitti? okur))
+                     (char= #\, (kar-bak okur)))
+            (kar-oku okur)
+            (boşluk-geç okur)
+            (anlam-oku okur)))))
+
+(defmethod kelime-oku ((okur okur))
+  (let (kanji kana anlam grup altgrup)
+    (setf kanji (kanji-oku okur))
+    (boşluk-geç okur)
+    (setf kana (kana-oku okur))
+    (setf anlam (anlam-oku okur))
+    (when (and (not (metin-bitti? okur))
+               (char= #\| (kar-bak okur)))
+      ;; (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"))
+               (boşluk-geç okur)
+               (setf altgrup (sonraki-öbek okur '(#\Newline #\Space #\;))))
+              ((char= #\, (kar-bak okur))
+               (kar-oku okur)
+               (boşluk-geç okur)
+               (push (sonraki-öbek okur '(#\Newline #\Space #\;)) grup))))
+    (make-instance 'kelime :kanji kanji :kana kana :anlam anlam
+                           :grup grup :altgrup altgrup)))
+
+(defmethod işle ((okur okur))
+  (unless (eq :baş (durum okur))
+    (error "Okur zaten işlenmiş"))
+  (loop :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)))))
+  (kelimeler okur))
+
+(defmacro okurla ((isim dosya-ismi) &body beden)
+  `(let ((,isim (make-instance 'okur :dosya ,dosya-ismi)))
+     ,@beden))
+
+;; (defparameter *okur* nil)
+
+;; (defun test-okuru-yap ()
+;;   (setf *okur*
+;;         (make-instance 'okur :dosya "/home/riton/projects/japonca/örnek.txt"))
+;;   (metni-yükle *okur*))
+
+
+
+;; (buffer :accessor buffer :initform (make-array 1028 :element-type 'character
+;;                                                :fill-pointer 0))
+
+;; (defmethod yeni-satır ((okur okur))
+;;   (let* ((yeni-poz (position #\Newline (metin okur) :start (i okur)))
+;;          (fark (- yeni-poz (i okur))))
+;;     (setf (fill-pointer (buffer okur)) fark)
+;;     (replace (buffer okur) (metin okur)
+;;              :start1 0 :end1 fark
+;;              :start2 (i okur) :end2 yeni-poz)
+;;     (setf (i okur) (+ yeni-poz 1))
+;;     (buffer okur)))

paket.lisp

@@ -0,0 +1,2 @@
+(defpackage :japonca
+  (:use :common-lisp))

sayı.lisp

@@ -0,0 +1,46 @@
+(let ((sayılar (vector "" "一" "二" "三" "四" "五" "六" "七" "八" "九" "十"))
+      (basamaklar (vector "" "" "十" "百" "千" "万")))
+  (defun sayı->yazılış (sayı &optional (stream *standard-output*))
+    (labels ((öz (sayı basamak)
+               (multiple-value-bind (sayı rakam) (truncate sayı 10)
+                 (when (> sayı 0)
+                   (öz sayı (+ basamak 1)))
+                 (case basamak
+                   (1 (format stream "~a" (aref sayılar rakam)))
+                   (t (case rakam
+                        (0)
+                        (1 (format stream "~a" (aref basamaklar basamak)))
+                        (t (format stream "~a~a"
+                                   (aref sayılar rakam)
+                                   (aref basamaklar basamak)))))))))
+      (cond ((= sayı 0) (format stream "れい"))
+            ((> sayı 99999) (error "sayı->yazılış: sayı 99999 dan küçük olmalı"))
+            (t (when (< sayı 0)
+                 (format stream "マイナス"))
+               (öz (abs sayı) 1))))))
+
+;; (defun sayı-sor (tip)
+;;   (let* ((sayı (random 99999))
+;;          (yazılış (with-output-to-string (str)
+;;                     (sayı->yazılış sayı str))))
+;;     (case tip
+;;       (:rakam
+;;        (format t "~a hangi sayıdır? " yazılış)
+;;        (let ((girdi (read)))
+;;          (if (= girdi sayı)
+;;              (format t "doğru.~%")
+;;              (format t "yanlış, ~d." sayı))))
+;;       (:yazılış
+;;        (format t "~a nasıl yazılır? " sayı)
+;;        (let ((girdi (string-left-trim '(#\Space) (read-line))))
+;;          (if (string-equal girdi yazılış)
+;;              (format t "doğru.~%")
+;;              (format t "yanlış, ~d." yazılış)))))))
+
+;; (let ((sayılar (vector "" "一" "二" "三" "四" "五" "六" "七" "八" "九" "十")))
+;;   (declare (ignorable sayılar))
+;;   (defun sayı->yazılış (sayı)
+;; 	(let (rakam)
+;; 	  (loop :do (multiple-value-setq (sayı rakam) (truncate sayı 10))
+;; 			:collect rakam
+;; 			:while (> sayı 0)))))

soru.lisp

@@ -0,0 +1,101 @@
+(in-package :japonca)
+
+(setf *random-state* (make-random-state t))
+
+(defparameter *kelimeler* nil)
+(defparameter *kelimeler-dosyası* "/home/riton/projects/japonca/kelimeler.txt")
+
+(defun kelimeleri-yükle (&optional (dosya *kelimeler-dosyası*))
+  (setf *kelimeler*
+        (okurla (okur dosya)
+          (metni-yükle okur)
+          (işle okur))))
+
+(defun kullanıcı-cevap ()
+  (let ((cevap (string-left-trim '(#\Space) (read-line))))
+    (cond ((string= "" cevap) :çık)
+          ((string= "？" cevap) :kopya)
+          ((char= #\: (char cevap 0)) (read-from-string cevap))
+          (t cevap))))
+
+(defparameter *soru-sayısı* nil)
+
+(defmethod kelime-soru :before (kelime tip)
+  (when *soru-sayısı*
+    (format t "~a. " *soru-sayısı*)))
+
+(defmethod kelime-soru ((kelime kelime) (tip (eql :okunuş)) )
+  (block soru
+    (let (cevap sonuç)
+      (format t "~a nasıl okunur ? " (kanji kelime))
+      (setf sonuç (loop :do (case (setf cevap (kullanıcı-cevap))
+                              (:çık (return-from soru :çık))
+                              (:kopya (format t "anlam: ~{~a~^, ~} : " (anlam kelime)))
+                              (t (return (kana= kelime cevap))))))
+      (when (not sonuç)
+        (format t "yanlış. ~{~a~^、~} olmalı~%" (kana kelime)))
+      sonuç)))
+
+(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*))
+  (when (not son)
+    (setf son (length *kelimeler*)))
+  (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)
+  (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))))))
+
+;; (defmacro soru-tanım (args &body beden)
+;;   `(block soru
+;;      (let (cevap sonuç)
+;;        (format t "~a nasıl okunur ? " (kanji kelime))
+;;        (setf sonuç
+;;              (loop :do (case (setf cevap (kullanıcı-cevap))
+;;                          (:çık (return-from soru))
+;;                          (:kopya (format t "anlam: ~{~a~^, ~} : " (anlam kelime)))
+;;                          (t (return (kana= kelime cevap))))))
+;;        (when (not sonuç)
+;;          (format t "yanlış. ~{~a~^、~} olmalı~%" (kana kelime))))))
+;; (soru-tanım (kelime :okunuş)
+;;             ;; (:doğru-cevap (kana kelime))
+;;             (:soru "~a nasıl okunur ?" (kanji kelime))
+;;             (:cevap
+;;              (:kopya (format t "anlamı : ~a" (anlam kelime))
+;;                      (setf cevap (kullanıcı-cevap))))
+;;             (:d "doğru.~%")
+;;             (:y "yanlış, doğrusu ~s.~%" (kana kelime)))
+
+;; (defmethod cevap-kontrol ((kelime kelime) cevap fn))
+;; (defmacro cevapla )
+
+;; (defmethod kelime-soru ((kelime kelime) (tip (eql :okunuş)))
+;;   (block soru
+;;     (labels ((cevapla ()
+;;                (let ((cevap (kullanıcı-cevap)))
+;;                  (case cevap
+;;                    (:çık (return))
+;;                    (:kopya (format t "anlam: ~{~a~^, ~} : " (anlam kelime))
+;;                     (cevapla))
+;;                    (t (kana= kelime cevap))))))
+;;       (format t "~a. ~a nasıl okunur ? " *soru-sayısı* (kanji kelime))
+;;       (loop :for cevap := (kullanıcı-cevap)
+;;             :do (case cevap
+;;                   (:çık (return-from soru))
+;;                   (:kopya (format t "anlam: ~{~a~^, ~} : " (anlam kelime)))
+;;                   (t (return (kana= kelime cevap)))))
+;;       (if (cevapla)
+;;           (format t "doğru.~%")
+;;           (format t "yanlış. ~{~a~^、~} olmalı~%" (kana kelime))))))

util.lisp

@@ -0,0 +1,39 @@
+(in-package :japonca)
+
+(defun ağırlıklı-rastgele (options weights &optional length)
+  ;; (declare (type simple-array options) (type simple-array weights))
+  (let ((len (or length (length weights))))
+    (loop :with rand := (* (random 1.0) (aref weights (- len 1)))
+          :for i :from 0 :below (length weights)
+          :when (> (aref weights i) rand)
+          :do (return (aref options i)))))
+
+(defun ağırlık-ata (weights &optional length)
+  (let ((len (or length (length weights))))
+    (loop :for i :from 1 :below len
+          :do (incf (aref weights i)
+                    (aref weights (- i 1))))
+    weights))
+
+(defun dosya-metni-oku (dosya)
+  (let* ((uzunluk 0)
+         (metin
+           (with-output-to-string (out)
+             (with-open-file (in dosya :external-format :utf-8)
+               (loop :with buffer := (make-array 8192 :element-type 'character)
+                     :for n := (read-sequence buffer in)
+                     :while (< 0 n)
+                     :do (incf uzunluk n)
+                         (write-sequence buffer out :start 0 :end n))))))
+    (values metin uzunluk)))
+
+
+
+;; (defun random-test (options weigths)
+;;   (let ((opts options)
+;; 		(weights (set-weights-array weigths))
+;; 		(times (make-array 3 :initial-element 0)))
+;; 	(loop :for i :from 0 :below 1000
+;; 		  :for choice := (weighted-random opts weights)
+;; 		  :do (incf (aref times choice)))
+;; 	times))