1;;; cannav3-socket.scm: Canna protocol version 3 for uim.
2;;;
3;;; Copyright (c) 2009-2013 uim Project https://github.com/uim/uim
4;;;
5;;; All rights reserved.
6;;;
7;;; Redistribution and use in source and binary forms, with or without
8;;; modification, are permitted provided that the following conditions
9;;; are met:
10;;; 1. Redistributions of source code must retain the above copyright
11;;;    notice, this list of conditions and the following disclaimer.
12;;; 2. Redistributions in binary form must reproduce the above copyright
13;;;    notice, this list of conditions and the following disclaimer in the
14;;;    documentation and/or other materials provided with the distribution.
15;;; 3. Neither the name of authors nor the names of its contributors
16;;;    may be used to endorse or promote products derived from this software
17;;;    without specific prior written permission.
18;;;
19;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS'' AND
20;;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
21;;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
22;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE
23;;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
24;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
25;;; OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
26;;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
27;;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
28;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
29;;; SUCH DAMAGE.
30;;;;
31
32(use srfi-1)
33(require "socket.scm")
34(require "lolevel.scm")
35
36;; canna protocol operators
37(define canna-lib-initialize-op          #x1)
38(define canna-lib-finalize-op            #x2)
39(define canna-lib-create-context-op      #x3)
40(define canna-lib-close-context-op       #x5)
41(define canna-lib-get-dictionary-list-op #x6)
42(define canna-lib-mount-dictionary-op    #x8)
43(define canna-lib-unmount-dictionary-op  #x9)
44(define canna-lib-begin-convert-op       #xf)
45(define canna-lib-end-convert-op         #x10)
46(define canna-lib-get-candidacy-list-op  #x11)
47(define canna-lib-get-yomi-op            #x12)
48(define canna-lib-resize-pause-op        #x1a)
49
50(define (canna-var&user-fmt user)
51  (format "3.3:~a" user))
52
53(define (canna-lib-initialize socket user)
54  (let* ((canna-var&user (canna-var&user-fmt user))
55         (canna-var&user-len (+ 1 (string-length canna-var&user))))
56    (file-write socket
57                (u8list->string-buf
58                 (u8list-pack '(u32 u32 s8)
59                              canna-lib-initialize-op canna-var&user-len canna-var&user)))
60    (call-with-u8list-unpack
61     '(u16 u16) (string-buf->u8list (file-read socket 4))
62     (lambda (major minor)
63       (not (and (= major 65535) (= major 65535)))))))
64
65(define (canna-lib-finalize socket)
66  (file-write socket
67              (u8list->string-buf
68               (u8list-pack '(u8 u8 u16)
69                            canna-lib-finalize-op 0 0)))
70  (call-with-u8list-unpack
71   '(u32 u8) (string-buf->u8list (file-read socket 5))
72        (lambda (dummy result)
73          (= result 0))))
74
75(define (canna-lib-create-context socket)
76  (file-write socket
77              (u8list->string-buf
78               (u8list-pack '(u8 u8 u16)
79                            canna-lib-create-context-op 0 0)))
80  (call-with-u8list-unpack
81   '(u32 u16) (string-buf->u8list (file-read socket 6))
82   (lambda (dummy context-id)
83     (and (not (= context-id 65535))
84          context-id))))
85
86(define (canna-lib-close-context socket context-id)
87  (file-write socket
88              (u8list->string-buf
89               (u8list-pack '(u8 u8 u16 u16)
90                            canna-lib-close-context-op 0 2 context-id)))
91  (call-with-u8list-unpack
92   '(u32 u8) (string-buf->u8list (file-read socket 5))
93   (lambda (dummy result)
94     (not (= result 255)))))
95
96(define (canna-lib-get-dictionary-list socket context-id)
97  (file-write socket
98              (u8list->string-buf
99               (u8list-pack '(u8 u8 u16 u16 u16)
100                            canna-lib-get-dictionary-list-op 0 4 context-id 1024)))
101  (call-with-u8list-unpack
102   '(u32 u16) (string-buf->u8list (file-read socket 6))
103   (lambda (dummy result)
104     (and (not (= result 65535))
105          (call-with-u8list-unpack
106           (make-list result 's8) (string-buf->u8list (file-read socket 1024))
107           (lambda dict-list
108             dict-list))))))
109
110(define (canna-lib-mount-dictionary socket context-id dict mode)
111  (file-write socket
112              (u8list->string-buf
113               (u8list-pack '(u8 u8 u16 u32 u16 s8)
114                            canna-lib-mount-dictionary-op
115                            0
116                            (+ (string-length dict) 7)
117                            mode context-id dict)))
118  (call-with-u8list-unpack
119   '(u32 u8) (string-buf->u8list (file-read socket 5))
120   (lambda (dummy result)
121     (not (= result 255)))))
122
123(define (canna-lib-unmount-dictionary socket context-id dict mode)
124  (file-write socket
125              (u8list->string-buf
126               (u8list-pack '(u8 u8 u16 u32 u16 s8)
127                            canna-lib-unmount-dictionary-op
128                            0
129                            (+ (string-length dict) 7)
130                            mode context-id dict)))
131  (call-with-u8list-unpack
132   '(u32 u8) (string-buf->u8list (file-read socket 5))
133   (lambda (dummy result)
134     (not (= result 255)))))
135
136(define (canna-lib-begin-convert socket context-id yomi mode)
137  (file-write socket
138              (u8list->string-buf
139               (u8list-pack '(u8 u8 u16 u32 u16 s16)
140                            canna-lib-begin-convert-op
141                            0
142                            (+ (string-length yomi) 8)
143                            mode context-id yomi)))
144  (call-with-u8list-unpack
145   '(u16 u16 u16) (string-buf->u8list (file-read socket 6))
146   (lambda (dummy len bunsetsu)
147     (and (not (= bunsetsu 65535))
148          (call-with-u8list-unpack
149           (make-list bunsetsu 's16) (string-buf->u8list (file-read socket len))
150           (lambda conv
151             conv))))))
152
153(define (canna-lib-end-convert socket context-id cands mode)
154  (file-write socket
155              (u8list->string-buf
156               (u8list-pack '(u8 u8 u16 u16 u16 u32 u16list)
157                            canna-lib-end-convert-op
158                            0
159                            (+ (* 2 (length cands)) 8)
160                            context-id (length cands) mode
161                            cands)))
162  (call-with-u8list-unpack
163   '(u32 u8) (string-buf->u8list (file-read socket 5))
164   (lambda (dummy result)
165     (not (= result 255)))))
166
167(define (canna-lib-get-candidacy-list socket context-id bunsetsu-pos)
168  (file-write socket
169              (u8list->string-buf
170               (u8list-pack '(u8 u8 u16 u16 u16 u16)
171                            canna-lib-get-candidacy-list-op
172                            0
173                            6
174                            context-id bunsetsu-pos 1024)))
175  (call-with-u8list-unpack
176   '(u16 u16 u16) (string-buf->u8list (file-read socket 6))
177   (lambda (dummy len cands)
178     (call-with-u8list-unpack
179      (make-list cands 's16) (string-buf->u8list (file-read socket len))
180      (lambda cand-list
181        cand-list)))))
182
183(define (canna-lib-get-yomi socket context-id bunsetsu-pos)
184  (file-write socket
185              (u8list->string-buf
186               (u8list-pack '(u8 u8 u16 u16 u16 u16)
187                            canna-lib-get-yomi-op
188                            0
189                            6
190                            context-id bunsetsu-pos 1024)))
191  (call-with-u8list-unpack
192   '(u16 u16 u16) (string-buf->u8list (file-read socket 6))
193   (lambda (dummy len yomi-len)
194     (call-with-u8list-unpack
195      '(s16) (string-buf->u8list (file-read socket len))
196      (lambda (conv)
197        conv)))))
198
199(define (canna-lib-resize-pause socket context-id yomi-length bunsetsu-pos)
200  (file-write socket
201              (u8list->string-buf
202               (u8list-pack '(u8 u8 u16 u16 u16 u16)
203                            canna-lib-resize-pause-op
204                            0
205                            6
206                            context-id bunsetsu-pos yomi-length)))
207  (call-with-u8list-unpack
208   '(u16 u16 u16) (string-buf->u8list (file-read socket 6))
209   (lambda (dummy len bunsetsu)
210     (and (not (= bunsetsu 65535))
211          (let loop ((s16list (string-buf->u8list (file-read socket len)))
212                     (rest '()))
213            (if (equal? s16list '(0 0))
214                (reverse rest)
215                (let ((s16 (u8list-unpack '(s16) s16list)))
216                  (loop (drop s16list (+ 2 (string-length (car s16))))
217                        (cons (car s16) rest)))))))))
218
219;;
220;; RK compatible functions
221;;
222(define canna-lib-context-rec-spec
223  (list
224   (list 'id   #f)
225   (list 'mode 0)
226   (list 'nostudy #f)
227   (list 'cands '())
228   (list 'nth-cands '#())
229   (list 'dic-list '())))
230(define-record 'canna-lib-context canna-lib-context-rec-spec)
231(define canna-lib-context-new-internal canna-lib-context-new)
232
233(define *canna-lib-socket* #f)
234(define *canna-lib-context-list* '())
235(define canna-lib-cannaserver #f)
236
237(define (canna-lib-open-with-server server)
238  (let ((server-name (if (equal? server "")
239                         "localhost"
240                         server)))
241    (if canna-server-name
242        (tcp-connect server-name "canna")
243        (unix-domain-socket-connect "/tmp/.iroha_unix/IROHA"))))
244
245(define (canna-lib-init server)
246  (set! canna-lib-cannaserver server)
247  (and (not *canna-lib-socket*)
248       (let ((s (canna-lib-open-with-server server)))
249         (and s
250              (begin
251                (canna-lib-initialize s canna-user-name)
252                (set! *canna-lib-socket* s)
253                #t)))))
254
255(define (canna-lib-alloc-context)
256  (if (and (not *canna-lib-socket*)
257           (not (canna-lib-init canna-lib-cannaserver)))
258      (begin
259        (uim-notify-fatal (N_ "Initialize failed."))
260        #f)
261      (and-let* ((cic (canna-lib-context-new-internal))
262                 (id (canna-lib-create-context *canna-lib-socket*))
263                 (dic-list (canna-lib-context-set-dic-list!
264                            cic
265                            (canna-lib-get-dictionary-list *canna-lib-socket* id)))
266                 (mode 19))  ;; XXX: (RK_XFER << RK_XFERBITS) | RK_KFER
267        (canna-lib-context-set-id! cic id)
268        (canna-lib-context-set-mode! cic mode)
269        (map (lambda (dict)
270               (canna-lib-mount-dictionary *canna-lib-socket* id dict 0))
271             dic-list)
272        (set! *canna-lib-context-list*
273              (cons cic *canna-lib-context-list*))
274        cic)))
275
276(define (canna-lib-release-context cic)
277  (set! *canna-lib-context-list* (delete! cic *canna-lib-context-list* equal?))
278  (canna-lib-close-context *canna-lib-socket*
279                           (canna-lib-context-id cic)))
280
281(define (canna-lib-begin-conversion cic str)
282  (let ((cands (canna-lib-begin-convert *canna-lib-socket*
283                                        (canna-lib-context-id cic)
284                                        str
285                                        (canna-lib-context-mode cic))))
286    (canna-lib-context-set-cands! cic cands)
287    (canna-lib-context-set-nth-cands! cic (make-vector (length cands) 0))
288    (length cands)))
289
290(define (canna-lib-get-nth-candidate cic seg nth)
291  (vector-set! (canna-lib-context-nth-cands cic) seg nth)
292  (list-ref (canna-lib-get-candidacy-list *canna-lib-socket*
293                                          (canna-lib-context-id cic)
294                                          seg)
295            nth))
296
297(define (canna-lib-get-unconv-candidate cic seg)
298  (canna-lib-context-set-nth-cands! cic (vector-set! (canna-lib-context-nth-cands cic) seg 0))
299  (canna-lib-get-yomi *canna-lib-socket*
300                      (canna-lib-context-id cic)
301                      seg))
302
303(define (canna-lib-resize-segment cic seg delta)
304  (let* ((direct (if (< 0 delta)
305                    -1
306                    -2))
307         (new-cands (canna-lib-resize-pause *canna-lib-socket*
308                                            (canna-lib-context-id cic) direct seg))
309         (len (length new-cands))
310         (new-nth-cands (make-vector (+ seg len) 0)))
311    ;; save unconverted segments
312    (for-each (lambda (n)
313                (vector-set! new-nth-cands
314                             n
315                             (vector-ref (canna-lib-context-nth-cands cic) n)))
316              (iota seg))
317    (canna-lib-context-set-cands! cic new-cands)
318    (canna-lib-context-set-nth-cands! cic new-nth-cands)
319    #t))
320
321(define (canna-lib-get-nr-segments cic)
322  (vector-length (canna-lib-context-nth-cands cic)))
323
324(define (canna-lib-get-nr-candidates cic seg)
325  (length (canna-lib-get-candidacy-list *canna-lib-socket*
326                                        (canna-lib-context-id cic)
327                                        seg)))
328
329(define (canna-lib-commit-segment cic seg nth)
330  (let ((nth-cands (vector->list (canna-lib-context-nth-cands cic)))
331        (learn (if (canna-lib-context-nostudy cic)
332                   0
333                   1)))
334    (canna-lib-end-convert *canna-lib-socket*
335                           (canna-lib-context-id cic)
336                           nth-cands
337                           learn)))
338
339(define (canna-lib-reset-conversion cic)
340  (let ((nth-cands (vector->list (canna-lib-context-nth-cands cic))))
341    (canna-lib-end-convert *canna-lib-socket*
342                           (canna-lib-context-id cic)
343                           nth-cands
344                           0)))
345