init

1 files changed, 72 insertions, 0 deletions

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