blob: 3a76f05f75e16f177fca1c4f4a8e9a1466f35775 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
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)))
|
