New file.

diff --git a/concord-setsumon.el b/concord-setsumon.el
new file mode 100644 (file)
index 0000000..bb62ffb
--- /dev/null
+++ b/concord-setsumon.el
@@ -0,0 +1,76 @@
+(concord-assign-genre 'glyph-image "/usr/local/var/photo/db")
+
+;; (concord-assign-genre 'hng-card "/usr/local/var/hng-card/db")
+;; (mount-char-attribute-table '->HNG)
+;; (mount-char-attribute-table '<-HNG)
+
+(defun concord-setsumon-add-rep-img (img-specifier char)
+  (let ((ret (split-string img-specifier "_"))
+       folder page char-num geo width height off-x off-y ratio
+       img-url base-cobj base-id
+       seg-cobj
+       seg-glyph-cobj seg-glyph-id
+       page-offset ccs rep-glyph)
+    (when ret
+      (setq page (pop ret)
+           char-num (string-to-int (pop ret))
+           geo (pop ret))
+      (setq folder (substring page 0 4)
+           page (substring page 4))
+      (setq img-url
+           (format
+            "http://image.kanji.zinbun.kyoto-u.ac.jp/images/zinbun/toho/%s/%s%s.jpg"
+            folder folder page))
+      (when (string-match
+            "^\\([0-9]+\\)x\\([0-9]+\\)\\+\\([0-9]+\\)\\+\\([0-9]+\\)$" geo)
+       (setq width  (string-to-int (match-string 1 geo))
+             height (string-to-int (match-string 2 geo))
+             off-x  (string-to-int (match-string 3 geo))
+             off-y  (string-to-int (match-string 4 geo)))
+       (setq ratio
+             (cond ((string= folder "A024")
+                    (setq page-offset 18
+                          ccs '===shuowen-jiguge4)
+                    1.8175)
+                   ((string= folder "A020")
+                    (setq page-offset 16
+                          ccs '===shuowen-jiguge5)
+                    2.07)
+                   (t
+                    1)))
+       (setq base-cobj
+             (concord-images-add-url
+              img-url
+              (format
+               "http://image.kanji.zinbun.kyoto-u.ac.jp/images/iiif/zinbun/toho/%s/%s%s.tif"
+               folder folder page)
+              (format
+               "http://image.kanji.zinbun.kyoto-u.ac.jp/iipsrv/iipsrv.fcgi?FIF=/zinbun/toho/%s/%s%s.tif&CVT=jpeg"
+               folder folder page)))
+       (setq base-id (concord-object-get base-cobj '=id))
+       (setq seg-cobj
+             (concord-images-add-segments base-cobj
+                                          (round (* off-x ratio))
+                                          (round (* off-y ratio))
+                                          (round (* width ratio))
+                                          (round (* height ratio))))
+       (setq seg-glyph-id (intern (format "%s/char=%d" base-id char-num)))
+       (unless (setq seg-glyph-cobj
+                     (concord-decode-object '=id seg-glyph-id))
+         (setq seg-glyph-cobj
+               (concord-make-object 'glyph-image seg-glyph-id))
+         (concord-object-adjoin*
+          seg-glyph-cobj '->image-resource seg-cobj)
+         (concord-object-adjoin*
+          seg-glyph-cobj '<-segmented-glyph-image base-cobj)
+         )
+       (concord-object-adjoin*
+        seg-glyph-cobj 'character char)
+       (when ccs
+         (setq rep-glyph
+               (decode-char ccs (+ (* (- (string-to-int page) page-offset)
+                                      100)
+                                   char-num)))
+         (concord-object-put seg-glyph-cobj 'representative-glyph
+                             (list rep-glyph)))
+       ))))