1 (concord-assign-genre 'image-resource "/usr/local/var/photo/db")
3 (defun concord-images-encode-url-as-id (url &optional base)
7 (string-match (concat "^" (regexp-quote base)) url))
8 (setq ret (substring url (match-end 0)))
9 (if (string-match "\\.[a-zA-Z0-9]+$" ret)
10 (substring ret 0 (match-beginning 0))
13 ((string-match "^http://\\(hng\\|image\\)\\.\\(chise\\.org\\|kanji\\.zinbun\\.kyoto-u\\.ac\\.jp\\)/images/iiif/" url)
14 (setq ret (substring url (match-end 0)))
15 (if (string-match "\\.[a-zA-Z0-9]+$" ret)
16 (substring ret 0 (match-beginning 0))
19 ((string-match "^http://\\(hng\\|image\\)\\.\\(chise\\.org\\|kanji\\.zinbun\\.kyoto-u\\.ac\\.jp\\)/images/" url)
20 (setq ret (substring url (match-end 0)))
21 (if (string-match "\\.[a-zA-Z0-9]+$" ret)
22 (substring ret 0 (match-beginning 0))
25 ((string-match "^http://" url)
26 (substring url (match-end 0))
31 (defun concord-images-add-url (url &optional iiif iip base prefix prefer-iiif)
32 (let (img-id img-cobj)
33 (unless (setq img-cobj (concord-decode-object '=location url
39 (concord-images-encode-url-as-id iiif base)
40 (concord-images-encode-url-as-id url base)))))
41 (setq img-cobj (concord-make-object 'image-resource img-id))
42 (concord-object-put img-cobj '=location url)
44 (concord-object-put img-cobj '=location@iiif iiif)
47 "curl" nil (current-buffer) nil
49 (concat iiif "/info.json"))
50 (goto-char (point-min))
51 (when (re-search-forward
52 "^[ \t]*\"width\"[ \t]*:[ \t]*\\([0-9]+\\)" nil t)
53 (concord-object-put img-cobj 'image-width
54 (string-to-int (match-string 1))))
55 (when (re-search-forward
56 "^[ \t]*\"height\"[ \t]*:[ \t]*\\([0-9]+\\)" nil t)
57 (concord-object-put img-cobj 'image-height
58 (string-to-int (match-string 1))))
61 (concord-object-put img-cobj '=location@iip iip))
65 (defun concord-images-add-iiif (url &optional base)
66 (let (img-id img-cobj)
67 (unless (setq img-cobj (concord-decode-object '=location url
69 (setq img-id (intern (concord-images-encode-url-as-id url base)))
70 (setq img-cobj (concord-make-object 'image-resource img-id))
71 (concord-object-put img-cobj '=location@iiif url))
74 (defun concord-images-add-segments (base-cobj x y width height)
75 (let ((base-id (concord-object-get base-cobj '=id))
76 base-width base-width-f base-height-f
78 seg-id seg-iiif-url seg-cobj
80 rel-x rel-y rel-w rel-h)
81 (setq seg-id (intern (format "%s/xywh=%d,%d,%d,%d"
84 (unless (setq seg-cobj (concord-decode-object '=id seg-id
86 (setq seg-cobj (concord-make-object 'image-resource seg-id))
87 (setq base-iiif-url (concord-object-get base-cobj '=location@iiif))
88 (concord-object-put seg-cobj '=location
89 (format "%s#xywh=%d,%d,%d,%d"
90 (concord-object-get base-cobj '=location)
92 (concord-object-put seg-cobj 'image-offset-x x)
93 (concord-object-put seg-cobj 'image-offset-y y)
94 (concord-object-put seg-cobj 'image-width width)
95 (concord-object-put seg-cobj 'image-height height)
96 (setq seg-iiif-url (format "%s/%d,%d,%d,%d/full/0/default.jpg"
97 base-iiif-url x y width height))
98 (concord-object-put seg-cobj '=location@iiif seg-iiif-url)
99 (when (setq base-iip-url (concord-object-get base-cobj '=location@iip))
100 (setq base-width (concord-object-get base-cobj 'image-width)
101 base-width-f (float base-width)
103 (concord-object-get base-cobj 'image-height)))
104 (setq rel-x (/ x base-width-f)
105 rel-y (/ y base-height-f)
106 rel-w (/ width base-width-f)
107 rel-h (/ height base-height-f))
108 (if (string-match "&CVT=jpeg" base-iip-url)
109 (setq base-iip-url (substring base-iip-url 0 (match-beginning 0))))
111 seg-cobj '=location@iip
112 (format "%s&RGN=%f,%f,%f,%f&WID=%d&CVT=jpeg"
113 base-iip-url rel-x rel-y rel-w rel-h width)))
114 (concord-object-adjoin* seg-cobj '<-image-segment base-cobj)
118 (provide 'concord-images)