diff options
author | riton <riton@riton.home> | 2025-02-11 23:03:13 +0300 |
---|---|---|
committer | riton <riton@riton.home> | 2025-02-11 23:03:13 +0300 |
commit | d683a2e52f89131b50129d2a99483fba8bf096b0 (patch) | |
tree | fbd37b6d17b73930a2e3432692c52676017a6ba9 |
init
-rw-r--r-- | README.txt | 4 | ||||
-rw-r--r-- | japonca.asd | 13 | ||||
-rw-r--r-- | kelime.lisp | 72 | ||||
-rw-r--r-- | kelime/kelimeler.txt | 259 | ||||
-rw-r--r-- | okur.lisp | 158 | ||||
-rw-r--r-- | paket.lisp | 2 | ||||
-rw-r--r-- | sayı.lisp | 46 | ||||
-rw-r--r-- | soru.lisp | 101 | ||||
-rw-r--r-- | util.lisp | 39 |
9 files changed, 694 insertions, 0 deletions
diff --git a/README.txt b/README.txt new file mode 100644 index 0000000..887a8bf --- /dev/null +++ b/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. diff --git a/japonca.asd b/japonca.asd new file mode 100644 index 0000000..cc5a775 --- /dev/null +++ b/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"))) diff --git a/kelime.lisp b/kelime.lisp new file mode 100644 index 0000000..ca830f5 --- /dev/null +++ b/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))))) diff --git a/kelime/kelimeler.txt b/kelime/kelimeler.txt new file mode 100644 index 0000000..57e648a --- /dev/null +++ b/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/ diff --git a/okur.lisp b/okur.lisp new file mode 100644 index 0000000..3a76f05 --- /dev/null +++ b/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))) diff --git a/paket.lisp b/paket.lisp new file mode 100644 index 0000000..593c6a4 --- /dev/null +++ b/paket.lisp @@ -0,0 +1,2 @@ +(defpackage :japonca + (:use :common-lisp))
\ No newline at end of file diff --git a/sayı.lisp b/sayı.lisp new file mode 100644 index 0000000..3cbb273 --- /dev/null +++ b/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))))) diff --git a/soru.lisp b/soru.lisp new file mode 100644 index 0000000..2e5f2b4 --- /dev/null +++ b/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)))))) diff --git a/util.lisp b/util.lisp new file mode 100644 index 0000000..4180bd7 --- /dev/null +++ b/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)) |