concord-images.el

   1 (concord-assign-genre 'image-resource "/usr/local/var/photo/db")
   2
   3 (defun concord-images-encode-url-as-id (url)
   4   (let (ret)
   5     (cond
   6      ((string-match "^http://\\(hng\\|image\\)\\.\\(chise\\.org\\|kanji\\.zinbun\\.kyoto-u\\.ac\\.jp\\)/images/iiif/" url)
   7       (setq ret (substring url (match-end 0)))
   8       (if (string-match "\\.[a-zA-Z0-9]+$" ret)
   9           (substring ret 0 (match-beginning 0))
  10         ret)
  11       )
  12      ((string-match "^http://\\(hng\\|image\\)\\.\\(chise\\.org\\|kanji\\.zinbun\\.kyoto-u\\.ac\\.jp\\)/images/" url)
  13       (setq ret (substring url (match-end 0)))
  14       (if (string-match "\\.[a-zA-Z0-9]+$" ret)
  15           (substring ret 0 (match-beginning 0))
  16         ret)
  17       )
  18      ((string-match "^http://" url)
  19       (substring url (match-end 0))
  20       )
  21      (t
  22       url))))
  23
  24 (defun concord-images-add-url (url &optional iiif iip)
  25   (let (img-id img-cobj)
  26     (unless (setq img-cobj (concord-decode-object '=location url
  27                                                   'image-resource))
  28       (setq img-id (intern (concord-images-encode-url-as-id url)))
  29       (setq img-cobj (concord-make-object 'image-resource img-id))
  30       (concord-object-put img-cobj '=location url)
  31       (when iiif
  32         (concord-object-put img-cobj '=location@iiif iiif)
  33         (with-temp-buffer
  34           (call-process
  35            "curl" nil (current-buffer) nil
  36            "--silent"
  37            (concat iiif "/info.json"))
  38           (goto-char (point-min))
  39           (when (re-search-forward
  40                  "^[ \t]*\"width\"[ \t]*:[ \t]*\\([0-9]+\\)" nil t)
  41             (concord-object-put img-cobj 'image-width
  42                                 (string-to-int (match-string 1))))
  43           (when (re-search-forward
  44                  "^[ \t]*\"height\"[ \t]*:[ \t]*\\([0-9]+\\)" nil t)
  45             (concord-object-put img-cobj 'image-height
  46                                 (string-to-int (match-string 1))))
  47           ))
  48       (when iip
  49         (concord-object-put img-cobj '=location@iip iip))
  50       )
  51     img-cobj))
  52
  53 (defun concord-images-add-iiif (url)
  54   (let (img-id img-cobj)
  55     (unless (setq img-cobj (concord-decode-object '=location url
  56                                                   'image-resource))
  57       (setq img-id (intern (concord-images-encode-url-as-id url)))
  58       (setq img-cobj (concord-make-object 'image-resource img-id))
  59       (concord-object-put img-cobj '=location@iiif url))
  60     img-cobj))
  61
  62 (defun concord-images-add-segments (base-cobj x y width height)
  63   (let ((base-id (concord-object-get base-cobj '=id))
  64         base-width base-width-f base-height-f
  65         base-iiif-url
  66         seg-id seg-iiif-url seg-cobj
  67         base-iip-url
  68         rel-x rel-y rel-w rel-h)
  69     (setq seg-id (intern (format "%s/xywh=%d,%d,%d,%d"
  70                                  base-id
  71                                  x y width height)))
  72     (unless (setq seg-cobj (concord-decode-object '=id seg-id
  73                                                   'image-resource))
  74       (setq seg-cobj (concord-make-object 'image-resource seg-id))
  75       (setq base-iiif-url (concord-object-get base-cobj '=location@iiif))
  76       (concord-object-put seg-cobj '=location
  77                           (format "%s#xywh=%d,%d,%d,%d"
  78                                   (concord-object-get base-cobj '=location)
  79                                   x y width height))
  80       (concord-object-put seg-cobj 'image-offset-x x)
  81       (concord-object-put seg-cobj 'image-offset-y y)
  82       (concord-object-put seg-cobj 'image-width width)
  83       (concord-object-put seg-cobj 'image-height height)
  84       (setq seg-iiif-url (format "%s/%d,%d,%d,%d/full/0/default.jpg"
  85                                  base-iiif-url x y width height))
  86       (concord-object-put seg-cobj '=location@iiif seg-iiif-url)
  87       (when (setq base-iip-url (concord-object-get base-cobj '=location@iip))
  88         (setq base-width (concord-object-get base-cobj 'image-width)
  89               base-width-f (float base-width)
  90               base-height-f (float
  91                              (concord-object-get base-cobj 'image-height)))
  92         (setq rel-x (/ x base-width-f)
  93               rel-y (/ y base-height-f)
  94               rel-w (/ width base-width-f)
  95               rel-h (/ height base-height-f))
  96         (if (string-match "&CVT=jpeg" base-iip-url)
  97             (setq base-iip-url (substring base-iip-url 0 (match-beginning 0))))
  98         (concord-object-put
  99          seg-cobj '=location@iip
 100          (format "%s&RGN=%f,%f,%f,%f&WID=%d&CVT=jpeg"
 101                  base-iip-url rel-x rel-y rel-w rel-h width)))
 102       (concord-object-adjoin* seg-cobj '<-image-segment base-cobj)
 103       )
 104     seg-cobj))
 105
 106 (provide 'concord-images)