1 (concord-assign-genre 'image-resource "/usr/local/var/photo/db")
3 (defun concord-images-encode-url-as-id (url)
6 ((string-match "^http://hng\\.chise\\.org/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))
12 ((string-match "^http://hng\\.chise\\.org/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))
18 ((string-match "^http://" url)
19 (substring url (match-end 0))
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
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)
32 (concord-object-put img-cobj '=location@iiif iiif)
35 "curl" nil (current-buffer) nil
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 'width (string-to-int
43 (when (re-search-forward
44 "^[ \t]*\"height\"[ \t]*:[ \t]*\\([0-9]+\\)" nil t)
45 (concord-object-put img-cobj 'height (string-to-int
49 (concord-object-put img-cobj '=location@iip iip))
53 (defun concord-images-add-iiif (url)
54 (let (img-id img-cobj)
55 (unless (setq img-cobj (concord-decode-object '=location url
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))
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
66 seg-id seg-iiif-url seg-cobj
68 rel-x rel-y rel-w rel-h)
69 (setq seg-id (intern (format "%s/xywh=%d,%d,%d,%d"
72 (unless (setq seg-cobj (concord-decode-object '=id seg-id
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)
80 (concord-object-put seg-cobj 'offset-x x)
81 (concord-object-put seg-cobj 'offset-y y)
82 (concord-object-put seg-cobj 'width width)
83 (concord-object-put seg-cobj '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 'width)
89 base-width-f (float base-width)
90 base-height-f (float (concord-object-get base-cobj 'height)))
91 (setq rel-x (/ x base-width-f)
92 rel-y (/ y base-height-f)
93 rel-w (/ width base-width-f)
94 rel-h (/ height base-height-f))
95 (if (string-match "&CVT=jpeg" base-iip-url)
96 (setq base-iip-url (substring base-iip-url 0 (match-beginning 0))))
98 seg-cobj '=location@iip
99 (format "%s&RGN=%f,%f,%f,%f&WID=%d&CVT=jpeg"
100 base-iip-url rel-x rel-y rel-w rel-h width)))
101 (concord-object-adjoin* seg-cobj '<-image-segment base-cobj)
105 (provide 'concord-images)