concord-setsumon.el

   1 (concord-assign-genre 'glyph-image "/usr/local/var/photo/db")
   2
   3 ;; (concord-assign-genre 'hng-card "/usr/local/var/hng-card/db")
   4 ;; (mount-char-attribute-table '->HNG)
   5 ;; (mount-char-attribute-table '<-HNG)
   6
   7 (defun concord-setsumon-add-rep-img (img-specifier char)
   8   (let ((ret (split-string img-specifier "_"))
   9         folder page char-num geo width height off-x off-y ratio
  10         img-url base-cobj base-id
  11         seg-cobj
  12         seg-glyph-cobj seg-glyph-id
  13         page-offset ccs rep-glyph)
  14     (when ret
  15       (setq page (pop ret)
  16             char-num (string-to-int (pop ret))
  17             geo (pop ret))
  18       (setq folder (substring page 0 4)
  19             page (substring page 4))
  20       (setq img-url
  21             (format
  22              "http://image.kanji.zinbun.kyoto-u.ac.jp/images/zinbun/toho/%s/%s%s.jpg"
  23              folder folder page))
  24       (when (string-match
  25              "^\\([0-9]+\\)x\\([0-9]+\\)\\+\\([0-9]+\\)\\+\\([0-9]+\\)$" geo)
  26         (setq width  (string-to-int (match-string 1 geo))
  27               height (string-to-int (match-string 2 geo))
  28               off-x  (string-to-int (match-string 3 geo))
  29               off-y  (string-to-int (match-string 4 geo)))
  30         (setq ratio
  31               (cond ((string= folder "A024")
  32                      (setq page-offset 18
  33                            ccs '===shuowen-jiguge4)
  34                      1.8175)
  35                     ((string= folder "A020")
  36                      (setq page-offset 16
  37                            ccs '===shuowen-jiguge5)
  38                      2.07)
  39                     (t
  40                      1)))
  41         (setq base-cobj
  42               (concord-images-add-url
  43                img-url
  44                (format
  45                 "http://image.kanji.zinbun.kyoto-u.ac.jp/images/iiif/zinbun/toho/%s/%s%s.tif"
  46                 folder folder page)
  47                (format
  48                 "http://image.kanji.zinbun.kyoto-u.ac.jp/iipsrv/iipsrv.fcgi?FIF=/zinbun/toho/%s/%s%s.tif&CVT=jpeg"
  49                 folder folder page)))
  50         (setq base-id (concord-object-get base-cobj '=id))
  51         (setq seg-cobj
  52               (concord-images-add-segments base-cobj
  53                                            (round (* off-x ratio))
  54                                            (round (* off-y ratio))
  55                                            (round (* width ratio))
  56                                            (round (* height ratio))))
  57         (setq seg-glyph-id (intern (format "%s/char=%d" base-id char-num)))
  58         (unless (setq seg-glyph-cobj
  59                       (concord-decode-object '=id seg-glyph-id))
  60           (setq seg-glyph-cobj
  61                 (concord-make-object 'glyph-image seg-glyph-id))
  62           (concord-object-adjoin*
  63            seg-glyph-cobj '->image-resource seg-cobj)
  64           (concord-object-adjoin*
  65            seg-glyph-cobj '<-segmented-glyph-image base-cobj)
  66           )
  67         (concord-object-adjoin*
  68          seg-glyph-cobj 'character char)
  69         (when ccs
  70           (setq rep-glyph
  71                 (decode-char ccs (+ (* (- (string-to-int page) page-offset)
  72                                        100)
  73                                     char-num)))
  74           (concord-object-put seg-glyph-cobj 'representative-glyph
  75                               (list rep-glyph)))
  76         ))))