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