73 lines
2.8 KiB
Common Lisp
73 lines
2.8 KiB
Common Lisp
(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)))))
|